This is a brief workflow highlighting the exploratory analysis of survey data mined to assist in the writing of the manuscript, “Gender Disparities Persist in Endoscopy Suite” (Rabinowitz, et al.). Where appropriate, samples of the exact R syntax used will be displayed, along with the corresponding output (tabular data, graphical plots, maps, etc.).
require(broom)
require(dplyr)
SURVEY <-
GENDER_DIFF_DATA_LABELS %>%
filter( COMPLETE != "Incomplete" &
BIRTHSEX != "OTHER" &
!is.na(BIRTHSEX) ) %>%
select( RECORD_ID, BIRTHSEX, RACE_SOUTHASIAN:RACE_OTHER, AGE, TRAINING_LEVEL, HEIGHT, GLOVE, GLOVE_SIZE_AVAILABLE, PERFORMANCE_HOURS, TEACHER_GENDER_PREFERENCE,
FEMALE_TRAINERS, MALE_TRAINERS, EVER_INJURED, EXPERIENCED_TRANSIENT_PAIN_NO, EXPERIENCED_TRANSIENT_PAIN_HAND, EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER,
EXPERIENCED_TRANSIENT_PAIN_BACK, EXPERIENCED_TRANSIENT_PAIN_LEG, EXPERIENCED_TRANSIENT_PAIN_FOOT, GROWING_PAINS,
FELLOWSHIP_PREGNANCY, starts_with( c("PREGNANCY", "POSTPARTUM")),
FELLOWSHIP_FORMAL_ERGO_TRAINING, INFORMAL_TRAINING, TRAINING_TECHNIQUES_POSTURAL, TRAINING_TECHNIQUES_BEDHEIGHT, TRAINING_TECHNIQUES_BEDANGLE,
TRAINING_TECHNIQUES_MONITORHEIGHT, TRAINING_TECHNIQUES_MUSCULOSKELETAL, TRAINING_TECHNIQUES_EXERCISE_STRETCHING, TRAINING_TECHNIQUES_DIAL_EXTENDERS,
TRAINING_TECHNIQUES_PEDIATRIC_COLONOSCOPE, ERGO_TRAINING_BUDGET, ERGO_FEEDBACK, ERGO_FEEDBACK_BY_WHOM, ERGO_OPTIMIZATION, GLOVE_SIZE_AVAILABLE,
DIAL_EXTENDERS_AVAILABLE, DIAL_EXTENDERS_ENCOURAGED, DIAL_EXTENDERS_FEMALEATT, DIAL_EXTENDERS_MALEATT, PEDI_COLONOSCOPES_AVAILABLE,
LEAD_APRONS_DONTKNOW, LEAD_APRONS_LW_ONEPIECE, LEAD_APRONS_LW_TWOPIECE, LEAD_APRONS_STANDARD_ONEPIECE, LEAD_APRONS_STANDARD_TWOPIECE,
LEAD_APRONS_DOUBLE, LEAD_APRONS_THYROID, LEAD_APRONS_MATERNALDOS, LEAD_APRONS_FETALDOS,
ERGO_FORMAL_TIMEOUT_PRIOR, ERGO_INFORMAL_TIMEOUT_PRIOR, MONITORS_ADJUSTABLE, TEACHER_SENSITIVITY_STATURE_HANDSIZE,
TEACHER_SENSITIVITY_BY_GENDER, TACTILE_INSTRUCTION_FROM_MALES, TACTILE_INSTRUCTION_FROM_FEMALES,
COMFORTABLE_ASKING_NURSES, ASK_NURSES_ONCE, ASK_NURSES_TWICE, ASK_NURSES_MORE,
COMFORTABLE_ASKING_TECHS, MALE_ATTENDINGS_ASKING, FEMALE_ATTENDINGS_ASKING,
RECOGNIZED_RESPECTED_ES_STAFF, RECOGNIZED_RESPECTED_ANESTHETISTS, RECOGNIZED_RESPECTED_GASTRO_ATTENDING, FIRST_NAME_NO_PERMISSION,
ERGO_TRAINING_MANDATORY, ERGO_OPTIMIZAITON_BUDGET_REQUIRED, EXPERIENCE_IMPROVED_DIAL_EXTENDERS, EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES, EXPERIENCE_IMPROVED_APRONS,
ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED,
ERGONOMIC_IMPORTANCE, MITIGATING_MUSCLE_STRAIN, BED_POSITION, ENDO_TRAINER_POSITION, WHEN_DISABILITY_INSURANCE) %>%
mutate(AGE2 = ifelse( AGE %in% c('< 30', '30-34', '35-40'), AGE, '> 40' )) %>%
mutate( RACE = ifelse( RACE_HISPANIC == "Y", "HISPANIC",
ifelse( RACE_WHITE == "Y", "WHITE",
ifelse( RACE_BLACK == "Y", "BLACK",
ifelse (RACE_SOUTHASIAN == "Y", "ASIAN SOUTH",
ifelse (RACE_EASTASIAN == "Y", "ASIAN EAST",
ifelse (RACE_NATIVEAMER == "Y", "OTHER",
ifelse (RACE_PACIFICISLAND == "Y", "OTHER",
ifelse (RACE_OTHER == "Y", "OTHER", "OTHER" )))))))),
RACE = factor(RACE, levels= c('ASIAN EAST', 'ASIAN SOUTH', 'BLACK', 'HISPANIC', 'WHITE', 'OTHER'))) %>%
mutate( BIRTHSEX = factor( BIRTHSEX, levels= c("F","M") )) %>%
mutate (AGE2 = factor(AGE2, levels = c('< 30', '30-34', '35-40', '> 40'))) %>%
mutate (RACE2 = case_when( RACE != "WHITE" ~ 'NON-WHITE',
TRUE ~ 'WHITE'),
RACE2 = factor(RACE2, levels = c("WHITE", "NON-WHITE"))) %>%
mutate( TRAINING_LEVEL = factor (TRAINING_LEVEL, levels= c('First year fellow','Second year fellow', 'Third year fellow', 'Advanced fellow'))) %>%
mutate( TRAINING_LEVEL = recode_factor( TRAINING_LEVEL, 'First year fellow'= 'First Year',
'Second year fellow'= 'Second Year',
'Third year fellow' = 'Third Year',
'Advanced fellow' = "Advanced", .ordered = T) ) %>%
mutate( HEIGHT2 = factor(HEIGHT, levels= c("< 5'", "5-5'3", "5'4-5'6", "5'7-5'9", "5'10-6'", "6'1-6'4", "> 6'4"))) %>%
mutate( PERFORMANCE_HOURS = factor(PERFORMANCE_HOURS),
PERFORMANCE_HOURS = recode_factor(PERFORMANCE_HOURS, "< 10" = "< 10",
"10-20" = "10-20",
"21-30" = "21-30",
"31-40" = "31-40",
.default = "> 40")) %>%
mutate(TEACHER_GENDER_PREFERENCE = factor(TEACHER_GENDER_PREFERENCE),
TEACHER_GENDER_PREFERENCE = recode_factor(TEACHER_GENDER_PREFERENCE, "Yes" = "Yes",
.default = "No")) %>%
mutate( FEMALE_TRAINERS = factor(FEMALE_TRAINERS),
FEMALE_TRAINERS = recode_factor(FEMALE_TRAINERS, 'None' = 'None',
'1-2' = '1-2',
'3-5' = '3-5',
'6-10' = '6-10',
'> 10' = '> 10' )) %>%
mutate( MALE_TRAINERS = factor(MALE_TRAINERS),
MALE_TRAINERS = recode_factor(MALE_TRAINERS, 'None' = 'None',
'1-2' = '1-2',
'3-5' = '3-5',
'6-10' = '6-10',
'> 10' = '> 10' )) %>%
mutate( EVER_INJURED = factor(EVER_INJURED)) %>%
mutate( EXPERIENCED_TRANSIENT_PAIN_NO = factor(EXPERIENCED_TRANSIENT_PAIN_NO)) %>%
mutate( EXPERIENCED_TRANSIENT_PAIN_HAND = factor(EXPERIENCED_TRANSIENT_PAIN_HAND)) %>%
mutate( EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER = factor(EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER)) %>%
mutate( EXPERIENCED_TRANSIENT_PAIN_BACK = factor(EXPERIENCED_TRANSIENT_PAIN_BACK)) %>%
mutate( EXPERIENCED_TRANSIENT_PAIN_LEG = factor(EXPERIENCED_TRANSIENT_PAIN_LEG)) %>%
mutate( EXPERIENCED_TRANSIENT_PAIN_FOOT = factor(EXPERIENCED_TRANSIENT_PAIN_FOOT)) %>%
mutate( FELLOWSHIP_PREGNANCY = factor(FELLOWSHIP_PREGNANCY),
PREGNANCY_ERGO_DIFFICULTY = factor(PREGNANCY_ERGO_DIFFICULTY),
PREGNANCY_ERGO_INJURY = factor( PREGNANCY_ERGO_INJURY),
POSTPARTUM_ERGO_INJURY = factor( POSTPARTUM_ERGO_INJURY)) %>%
mutate( GROWING_PAINS = factor(GROWING_PAINS)) %>%
mutate( FELLOWSHIP_FORMAL_ERGO_TRAINING = factor(FELLOWSHIP_FORMAL_ERGO_TRAINING)) %>%
mutate( INFORMAL_TRAINING = factor(INFORMAL_TRAINING)) %>%
mutate( TRAINING_TECHNIQUES_POSTURAL = factor(TRAINING_TECHNIQUES_POSTURAL)) %>%
mutate( TRAINING_TECHNIQUES_BEDHEIGHT = factor(TRAINING_TECHNIQUES_BEDHEIGHT)) %>%
mutate( TRAINING_TECHNIQUES_BEDANGLE = factor(TRAINING_TECHNIQUES_BEDANGLE)) %>%
mutate( TRAINING_TECHNIQUES_MONITORHEIGHT = factor(TRAINING_TECHNIQUES_MONITORHEIGHT)) %>%
mutate( TRAINING_TECHNIQUES_MUSCULOSKELETAL = factor(TRAINING_TECHNIQUES_MUSCULOSKELETAL)) %>%
mutate( TRAINING_TECHNIQUES_EXERCISE_STRETCHING = factor(TRAINING_TECHNIQUES_EXERCISE_STRETCHING)) %>%
mutate( TRAINING_TECHNIQUES_DIAL_EXTENDERS = factor(TRAINING_TECHNIQUES_DIAL_EXTENDERS)) %>%
mutate( TRAINING_TECHNIQUES_PEDIATRIC_COLONOSCOPE = factor(TRAINING_TECHNIQUES_PEDIATRIC_COLONOSCOPE)) %>%
mutate( ERGO_TRAINING_BUDGET = factor(ERGO_TRAINING_BUDGET),
ERGO_TRAINING_BUDGET = recode_factor(ERGO_TRAINING_BUDGET, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T)) %>%
mutate( ERGO_FEEDBACK = factor(ERGO_FEEDBACK),
ERGO_FEEDBACK = recode_factor(ERGO_FEEDBACK, 'Never' = 'Never',
'Rarely' = 'Rarely',
'Sometimes' = 'Sometimes',
'Often' = 'Often', .ordered = T )) %>%
mutate( ERGO_FEEDBACK_BY_WHOM = factor(ERGO_FEEDBACK_BY_WHOM),
ERGO_FEEDBACK_BY_WHOM = recode_factor(ERGO_FEEDBACK_BY_WHOM, 'I do not or rarely receive ergonomic feedback' = "Do not/rarely received feedback",
'Mostly male endoscopy teachers' = 'Mostly male teachers',
'Mostly female endoscopy teachers' = 'Mostly female teachers',
'Both male and female endoscopy teachers equally' = 'Both equally' , .ordered = T)) %>%
mutate( ERGO_OPTIMIZATION = factor(ERGO_OPTIMIZATION),
ERGO_OPTIMIZATION = recode_factor(ERGO_OPTIMIZATION, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T)) %>%
mutate( GLOVE_SIZE_AVAILABLE = factor(GLOVE_SIZE_AVAILABLE)) %>%
mutate( DIAL_EXTENDERS_AVAILABLE = factor(DIAL_EXTENDERS_AVAILABLE),
DIAL_EXTENDERS_AVAILABLE = recode_factor(DIAL_EXTENDERS_AVAILABLE, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T)) %>%
mutate( DIAL_EXTENDERS_ENCOURAGED = factor(DIAL_EXTENDERS_ENCOURAGED),
DIAL_EXTENDERS_ENCOURAGED = recode_factor(DIAL_EXTENDERS_ENCOURAGED, 'Y' = 'Y',
'N' = 'N',
"Don't use" = 'DU', .ordered= T)) %>%
mutate( DIAL_EXTENDERS_FEMALEATT = factor(DIAL_EXTENDERS_FEMALEATT),
DIAL_EXTENDERS_FEMALEATT = recode_factor(DIAL_EXTENDERS_FEMALEATT, 'Not Likely' = 'Not Likely',
'Somewhat Likely' = 'Somewhat Likely',
'Sometimes' = 'Sometimes',
'Verly Likely' = 'Very Likely',
'NA' = 'NA', .ordered = T )) %>%
mutate( DIAL_EXTENDERS_MALEATT = factor(DIAL_EXTENDERS_MALEATT),
DIAL_EXTENDERS_MALEATT = recode_factor(DIAL_EXTENDERS_MALEATT, 'Not Likely' = 'Not Likely',
'Somewhat Likely' = 'Somewhat Likely',
'Sometimes' = 'Sometimes',
'Verly Likely' = 'Very Likely',
'NA' = 'NA', .ordered = T )) %>%
mutate( PEDI_COLONOSCOPES_AVAILABLE = factor(PEDI_COLONOSCOPES_AVAILABLE),
PEDI_COLONOSCOPES_AVAILABLE = recode_factor(PEDI_COLONOSCOPES_AVAILABLE, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T)) %>%
mutate( LEAD_APRONS_DONTKNOW = factor(LEAD_APRONS_DONTKNOW),
LEAD_APRONS_DONTKNOW = recode_factor(LEAD_APRONS_DONTKNOW, 'N' = 'Aware',
'Y' = 'Not Aware',.ordered= T)) %>%
mutate( TEACHER_SENSITIVITY_BY_GENDER = factor(TEACHER_SENSITIVITY_BY_GENDER),
TEACHER_SENSITIVITY_BY_GENDER = recode_factor(TEACHER_SENSITIVITY_BY_GENDER, 'Male' = 'Male',
'Female' = 'Female',
'Both equally' = 'Both Equally',
'I have not had female endoscopy teachers' = 'Never had female teacher',
'Not sure' = 'Not Sure', .ordered= T )) %>%
mutate( TACTILE_INSTRUCTION_FROM_MALES = factor(TACTILE_INSTRUCTION_FROM_MALES),
TACTILE_INSTRUCTION_FROM_MALES = recode_factor(TACTILE_INSTRUCTION_FROM_MALES, 'No' = 'No',
'Yes, rarely' = 'Rarely',
'Yes, often' = 'Often', .ordered= T)) %>%
mutate( TACTILE_INSTRUCTION_FROM_FEMALES = factor(TACTILE_INSTRUCTION_FROM_FEMALES),
TACTILE_INSTRUCTION_FROM_FEMALES = recode_factor(TACTILE_INSTRUCTION_FROM_FEMALES, 'No' = 'No',
'Yes, rarely' = 'Rarely',
'Yes, often' = 'Often', .ordered= T)) %>%
mutate( NURSES_ASKING = ifelse( ASK_NURSES_MORE == "Y", "More than Twice",
ifelse( ASK_NURSES_TWICE == "Y", "Twice",
ifelse( ASK_NURSES_ONCE == "Y", "Once", NA))),
NURSES_ASKING = factor(NURSES_ASKING),
NURSES_ASKING = recode_factor(NURSES_ASKING, "Once" = "Once",
"Twice" = "Twice",
"More than Twicce" = "More than Twice", .ordered=T),
MALE_ATTENDINGS_ASKING = factor(MALE_ATTENDINGS_ASKING),
MALE_ATTENDINGS_ASKING = recode_factor(MALE_ATTENDINGS_ASKING, "Once" = "Once",
"Twice" = "Twice",
"More than Twice" = "More than Twice", .ordered=T),
FEMALE_ATTENDINGS_ASKING = factor(FEMALE_ATTENDINGS_ASKING),
FEMALE_ATTENDINGS_ASKING = recode_factor(FEMALE_ATTENDINGS_ASKING, "Once" = "Once",
"Twice" = "Twice",
"More than twice" = "More than Twice",
"Not applicable, I do not work with any female attendings" = "Don't work with FemAtt", .ordered=T)) %>%
mutate( ERGO_TRAINING_MANDATORY = factor(ERGO_TRAINING_MANDATORY),
ERGO_TRAINING_MANDATORY = recode_factor(ERGO_TRAINING_MANDATORY, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T) ,
ERGO_OPTIMIZAITON_BUDGET_REQUIRED = factor(ERGO_OPTIMIZAITON_BUDGET_REQUIRED),
ERGO_OPTIMIZAITON_BUDGET_REQUIRED = recode_factor(ERGO_OPTIMIZAITON_BUDGET_REQUIRED, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T),
EXPERIENCE_IMPROVED_DIAL_EXTENDERS = factor(EXPERIENCE_IMPROVED_DIAL_EXTENDERS),
EXPERIENCE_IMPROVED_DIAL_EXTENDERS = recode_factor(EXPERIENCE_IMPROVED_DIAL_EXTENDERS, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T),
EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES = factor(EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES),
EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES = recode_factor(EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T) ,
EXPERIENCE_IMPROVED_APRONS = factor(EXPERIENCE_IMPROVED_APRONS),
EXPERIENCE_IMPROVED_APRONS = recode_factor(EXPERIENCE_IMPROVED_APRONS, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T),
ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED = factor(ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED),
ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED = recode_factor(ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED, 'Y' = 'Y',
'N' = 'N',
"Don't know" = 'DK', .ordered= T)) %>%
mutate( ERGONOMIC_IMPORTANCE = factor(ERGONOMIC_IMPORTANCE),
ERGONOMIC_IMPORTANCE = recode_factor(ERGONOMIC_IMPORTANCE, 'Both A and C' = 'Correct',
.default = 'Incorrect', .ordered= T) ,
MITIGATING_MUSCLE_STRAIN = factor(MITIGATING_MUSCLE_STRAIN),
MITIGATING_MUSCLE_STRAIN = recode_factor(MITIGATING_MUSCLE_STRAIN, 'All of the above' = 'Correct',
.default = 'Incorrect', .ordered= T) ,
BED_POSITION = factor(BED_POSITION),
BED_POSITION = recode_factor(BED_POSITION, '10 cm below elbow height' = 'Correct',
.default = 'Incorrect', .ordered= T) ,
ENDO_TRAINER_POSITION = factor(ENDO_TRAINER_POSITION),
ENDO_TRAINER_POSITION = recode_factor(ENDO_TRAINER_POSITION, 'At the foot of the bed, on the same side of the trainee.' = 'Correct',
.default = 'Incorrect', .ordered= T) ,
WHEN_DISABILITY_INSURANCE = factor(WHEN_DISABILITY_INSURANCE),
WHEN_DISABILITY_INSURANCE = recode_factor(WHEN_DISABILITY_INSURANCE, 'During training' = 'Correct',
.default = 'Incorrect', .ordered= T) )
Here’s a glimpse of the structure of the resulting dataset
SURVEY:
glimpse(SURVEY)
## Rows: 236
## Columns: 93
## $ RECORD_ID <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 1…
## $ BIRTHSEX <fct> F, F, F, M, F, F, F, F, F, M…
## $ RACE_SOUTHASIAN <chr> "N", "N", "N", "Y", "N", "N"…
## $ RACE_EASTASIAN <chr> "N", "N", "N", "N", "Y", "Y"…
## $ RACE_WHITE <chr> "N", "Y", "Y", "N", "N", "N"…
## $ RACE_BLACK <chr> "N", "N", "N", "N", "N", "N"…
## $ RACE_HISPANIC <chr> "Y", "N", "N", "N", "N", "N"…
## $ RACE_NATIVEAMER <chr> "N", "N", "N", "N", "N", "N"…
## $ RACE_PACIFICISLAND <chr> "N", "N", "N", "N", "N", "N"…
## $ RACE_OTHER <chr> "N", "N", "N", "N", "N", "N"…
## $ AGE <chr> "30-34", "30-34", "30-34", "…
## $ TRAINING_LEVEL <ord> Third Year, Third Year, Firs…
## $ HEIGHT <chr> "5'4-5'6", "5'4-5'6", "5'4-5…
## $ GLOVE <dbl> 6.5, 6.5, 6.0, 7.0, 6.5, 5.5…
## $ GLOVE_SIZE_AVAILABLE <fct> Y, Y, Y, Y, N, N, Y, Y, N, Y…
## $ PERFORMANCE_HOURS <fct> 10-20, < 10, 10-20, 31-40, 1…
## $ TEACHER_GENDER_PREFERENCE <fct> No, No, Yes, No, No, No, No,…
## $ FEMALE_TRAINERS <fct> None, 6-10, 6-10, 6-10, 6-10…
## $ MALE_TRAINERS <fct> 6-10, > 10, > 10, > 10, > 10…
## $ EVER_INJURED <fct> N, N, N, N, Y, N, N, N, N, N…
## $ EXPERIENCED_TRANSIENT_PAIN_NO <fct> Y, N, N, N, N, N, N, N, N, N…
## $ EXPERIENCED_TRANSIENT_PAIN_HAND <fct> N, Y, Y, Y, Y, Y, Y, N, N, Y…
## $ EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER <fct> N, Y, Y, Y, Y, N, Y, Y, Y, Y…
## $ EXPERIENCED_TRANSIENT_PAIN_BACK <fct> N, Y, Y, Y, Y, N, Y, N, N, Y…
## $ EXPERIENCED_TRANSIENT_PAIN_LEG <fct> N, N, Y, Y, N, N, N, N, N, N…
## $ EXPERIENCED_TRANSIENT_PAIN_FOOT <fct> N, N, Y, Y, N, Y, N, N, N, N…
## $ GROWING_PAINS <fct> NA, Y, Y, Y, Y, N, N, Y, N, …
## $ FELLOWSHIP_PREGNANCY <fct> N, Y, N, NA, N, N, N, N, N, …
## $ PREGNANCY_ERGO_DIFFICULTY <fct> NA, Y, NA, NA, NA, NA, NA, N…
## $ PREGNANCY_ERGO_INJURY <fct> NA, N, NA, NA, NA, NA, NA, N…
## $ POSTPARTUM_ERGO_INJURY <fct> NA, N, NA, NA, NA, NA, NA, N…
## $ FELLOWSHIP_FORMAL_ERGO_TRAINING <fct> N, N, N, N, N, N, N, Y, N, Y…
## $ INFORMAL_TRAINING <fct> Y, Y, Y, Y, Y, Y, N, Y, Y, Y…
## $ TRAINING_TECHNIQUES_POSTURAL <fct> Y, N, Y, Y, N, Y, Y, Y, N, Y…
## $ TRAINING_TECHNIQUES_BEDHEIGHT <fct> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y…
## $ TRAINING_TECHNIQUES_BEDANGLE <fct> Y, N, Y, Y, N, Y, Y, N, Y, Y…
## $ TRAINING_TECHNIQUES_MONITORHEIGHT <fct> Y, N, N, Y, N, Y, Y, N, Y, Y…
## $ TRAINING_TECHNIQUES_MUSCULOSKELETAL <fct> Y, N, N, Y, N, N, N, Y, Y, N…
## $ TRAINING_TECHNIQUES_EXERCISE_STRETCHING <fct> N, N, N, N, N, N, N, N, N, N…
## $ TRAINING_TECHNIQUES_DIAL_EXTENDERS <fct> N, N, Y, N, Y, N, Y, N, N, N…
## $ TRAINING_TECHNIQUES_PEDIATRIC_COLONOSCOPE <fct> Y, N, Y, Y, Y, N, Y, Y, Y, N…
## $ ERGO_TRAINING_BUDGET <ord> DK, N, DK, DK, N, DK, DK, N,…
## $ ERGO_FEEDBACK <ord> Sometimes, Rarely, Sometimes…
## $ ERGO_FEEDBACK_BY_WHOM <ord> Mostly male teachers, Mostly…
## $ ERGO_OPTIMIZATION <ord> DK, N, N, Y, N, N, Y, DK, N,…
## $ DIAL_EXTENDERS_AVAILABLE <ord> DK, N, Y, Y, Y, N, Y, DK, N,…
## $ DIAL_EXTENDERS_ENCOURAGED <ord> DU, N, Y, Y, Y, DU, Y, NA, N…
## $ DIAL_EXTENDERS_FEMALEATT <ord> NA, NA, Not likely, NA, Very…
## $ DIAL_EXTENDERS_MALEATT <ord> NA, NA, Very likely, NA, Ver…
## $ PEDI_COLONOSCOPES_AVAILABLE <ord> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y…
## $ LEAD_APRONS_DONTKNOW <ord> Aware, Aware, Not Aware, Awa…
## $ LEAD_APRONS_LW_ONEPIECE <chr> "N", "N", "N", "Y", "N", "Y"…
## $ LEAD_APRONS_LW_TWOPIECE <chr> "Y", "N", "N", "Y", "N", "Y"…
## $ LEAD_APRONS_STANDARD_ONEPIECE <chr> "N", "Y", "N", "Y", "N", "Y"…
## $ LEAD_APRONS_STANDARD_TWOPIECE <chr> "N", "Y", "N", "Y", "N", "Y"…
## $ LEAD_APRONS_DOUBLE <chr> "N", "N", "N", "N", "N", "N"…
## $ LEAD_APRONS_THYROID <chr> "N", "N", "N", "Y", "N", "N"…
## $ LEAD_APRONS_MATERNALDOS <chr> "N", "N", "N", "N", "N", "N"…
## $ LEAD_APRONS_FETALDOS <chr> "N", "N", "N", "N", "N", "N"…
## $ ERGO_FORMAL_TIMEOUT_PRIOR <chr> "N", "N", "N", "N", "N", "N"…
## $ ERGO_INFORMAL_TIMEOUT_PRIOR <chr> "Y", "N", "Y", "Y", "Y", "Y"…
## $ MONITORS_ADJUSTABLE <chr> "Y", "N", "N", "Y", "N", "Y"…
## $ TEACHER_SENSITIVITY_STATURE_HANDSIZE <chr> "Y", "N", "N", "Y", "N", "N"…
## $ TEACHER_SENSITIVITY_BY_GENDER <ord> Never had female teacher, No…
## $ TACTILE_INSTRUCTION_FROM_MALES <ord> Often, No, No, No, No, No, O…
## $ TACTILE_INSTRUCTION_FROM_FEMALES <ord> No, No, No, Rarely, Rarely, …
## $ COMFORTABLE_ASKING_NURSES <chr> "Y", "Y", "Y", "Y", "Y", "Y"…
## $ ASK_NURSES_ONCE <chr> "Y", "Y", "N", "N", "N", "Y"…
## $ ASK_NURSES_TWICE <chr> "N", "N", "Y", "N", "N", "N"…
## $ ASK_NURSES_MORE <chr> "N", "N", "N", "Y", "Y", "N"…
## $ COMFORTABLE_ASKING_TECHS <chr> "Y", "Y", "Y", "Y", "Y", "Y"…
## $ MALE_ATTENDINGS_ASKING <ord> Once, NA, More than twice, M…
## $ FEMALE_ATTENDINGS_ASKING <ord> Don't work with FemAtt, NA, …
## $ RECOGNIZED_RESPECTED_ES_STAFF <chr> "Y", "Y", "Y", "Y", "Y", "Y"…
## $ RECOGNIZED_RESPECTED_ANESTHETISTS <chr> "Y", "Y", "Y", "Y", "Y", "N"…
## $ RECOGNIZED_RESPECTED_GASTRO_ATTENDING <chr> "Y", "Y", "Y", "Y", "Y", "Y"…
## $ FIRST_NAME_NO_PERMISSION <chr> "N", "Y", "Y", "N", "N", "Y"…
## $ ERGO_TRAINING_MANDATORY <ord> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y…
## $ ERGO_OPTIMIZAITON_BUDGET_REQUIRED <ord> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y…
## $ EXPERIENCE_IMPROVED_DIAL_EXTENDERS <ord> DK, DK, Y, N, Y, Y, Y, DK, Y…
## $ EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES <ord> DK, N, Y, N, Y, Y, Y, N, Y, …
## $ EXPERIENCE_IMPROVED_APRONS <ord> N, Y, Y, N, Y, Y, Y, DK, Y, …
## $ ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED <ord> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y…
## $ ERGONOMIC_IMPORTANCE <ord> Incorrect, Correct, Correct,…
## $ MITIGATING_MUSCLE_STRAIN <ord> Incorrect, Correct, Correct,…
## $ BED_POSITION <ord> Incorrect, Incorrect, Correc…
## $ ENDO_TRAINER_POSITION <ord> Incorrect, Correct, Incorrec…
## $ WHEN_DISABILITY_INSURANCE <ord> Incorrect, Correct, Correct,…
## $ AGE2 <fct> 30-34, 30-34, 30-34, 30-34, …
## $ RACE <fct> HISPANIC, WHITE, WHITE, ASIA…
## $ RACE2 <fct> NON-WHITE, WHITE, WHITE, NON…
## $ HEIGHT2 <fct> 5'4-5'6, 5'4-5'6, 5'4-5'6, 6…
## $ NURSES_ASKING <ord> Once, Once, Twice, More than…
#Female/Male Totals
sqldf("select BIRTHSEX,
count(RECORD_ID) as N
from SURVEY
where BIRTHSEX in ('F','M')
group by 1")
## BIRTHSEX N
## 1 F 113
## 2 M 123
#Chi-Square Test of Proportions
fcount <- length(SURVEY$BIRTHSEX[SURVEY$BIRTHSEX =="F"])
mcount <- length(SURVEY$BIRTHSEX[SURVEY$BIRTHSEX =="M"])
fcount
## [1] 113
mcount
## [1] 123
females_males = c(fcount, mcount )
chisq.test(females_males, p= c(1/2, 1/2))
##
## Chi-squared test for given probabilities
##
## data: females_males
## X-squared = 0.42373, df = 1, p-value = 0.5151
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$AGE2, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Age Distribution by Birth Sex",
axis.titles = c('Respondents Age Bands'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET2 <-
SURVEY %>%
filter( !is.na(AGE2)) %>%
mutate(BIRTHSEX = recode_factor( BIRTHSEX, "M" = "MALES", "F" = "FEMALES", .ordered=T))
ggplot( SUBSET2, aes(x= AGE2)) + facet_grid( SUBSET2$BIRTHSEX ) +
geom_bar(aes(fill= BIRTHSEX) ) +
stat_count(geom="text", aes(label=..count..), vjust= -.1) +
scale_fill_manual( values = c( "MALES"="darkgrey", "FEMALES"="#006cc5"), guide = "none" )+
theme_538() +
xlab("Age Bands")+ ylab("Counts")
#Alternative View, if Birth Sex by Age is desired
CrossTable(SURVEY$AGE, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 236
##
##
## | SURVEY$BIRTHSEX
## SURVEY$AGE | F | M | Row Total |
## -------------|-----------|-----------|-----------|
## < 30 | 10 | 8 | 18 |
## | 0.088 | 0.065 | |
## -------------|-----------|-----------|-----------|
## 30-34 | 93 | 90 | 183 |
## | 0.823 | 0.732 | |
## -------------|-----------|-----------|-----------|
## 35-40 | 10 | 24 | 34 |
## | 0.088 | 0.195 | |
## -------------|-----------|-----------|-----------|
## 41-50 | 0 | 1 | 1 |
## | 0.000 | 0.008 | |
## -------------|-----------|-----------|-----------|
## Column Total | 113 | 123 | 236 |
## | 0.479 | 0.521 | |
## -------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 6.624273 d.f. = 3 p = 0.08488823
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.05670541
##
##
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$RACE, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Race Distribution by Birth Sex",
axis.titles = c('Race Categories '),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET2 <-
SURVEY %>%
filter( !is.na(RACE)) %>%
mutate(BIRTHSEX = recode_factor( BIRTHSEX, "M" = "MALES", "F" = "FEMALES", .ordered=T))
ggplot( SUBSET2, aes(x= RACE)) + facet_grid( SUBSET2$BIRTHSEX ) +
geom_bar(aes(fill= BIRTHSEX) ) +
stat_count(geom="text", aes(label=..count..), vjust= -.05) +
scale_fill_manual( values = c( "MALES"="darkgrey", "FEMALES"="#006cc5"), guide = "none" )+
theme_538() +
xlab("Race/Ethnicity Categories")+ ylab("Counts")
#Alternative View, if Birth Sex by Race is desired
CrossTable(SURVEY$RACE, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r = F, prop.t=F, chisq=T, fisher=F) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 236
##
##
## | SURVEY$BIRTHSEX
## SURVEY$RACE | F | M | Row Total |
## -------------|-----------|-----------|-----------|
## ASIAN EAST | 24 | 13 | 37 |
## | 0.212 | 0.106 | |
## -------------|-----------|-----------|-----------|
## ASIAN SOUTH | 33 | 23 | 56 |
## | 0.292 | 0.187 | |
## -------------|-----------|-----------|-----------|
## BLACK | 5 | 6 | 11 |
## | 0.044 | 0.049 | |
## -------------|-----------|-----------|-----------|
## HISPANIC | 9 | 6 | 15 |
## | 0.080 | 0.049 | |
## -------------|-----------|-----------|-----------|
## WHITE | 36 | 68 | 104 |
## | 0.319 | 0.553 | |
## -------------|-----------|-----------|-----------|
## OTHER | 6 | 7 | 13 |
## | 0.053 | 0.057 | |
## -------------|-----------|-----------|-----------|
## Column Total | 113 | 123 | 236 |
## | 0.479 | 0.521 | |
## -------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 15.27367 d.f. = 5 p = 0.009254827
##
##
##
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$TRAINING_LEVEL, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training Levels by Birth Sex",
axis.titles = c('Training Levels'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Training Level is desired
CrossTable(SURVEY$TRAINING_LEVEL, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=F) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 235
##
##
## | SURVEY$BIRTHSEX
## SURVEY$TRAINING_LEVEL | F | M | Row Total |
## ----------------------|-----------|-----------|-----------|
## First Year | 43 | 36 | 79 |
## | 0.381 | 0.295 | |
## ----------------------|-----------|-----------|-----------|
## Second Year | 41 | 36 | 77 |
## | 0.363 | 0.295 | |
## ----------------------|-----------|-----------|-----------|
## Third Year | 23 | 42 | 65 |
## | 0.204 | 0.344 | |
## ----------------------|-----------|-----------|-----------|
## Advanced | 6 | 8 | 14 |
## | 0.053 | 0.066 | |
## ----------------------|-----------|-----------|-----------|
## Column Total | 113 | 122 | 235 |
## | 0.481 | 0.519 | |
## ----------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 6.449267 d.f. = 3 p = 0.09168489
##
##
##
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$HEIGHT2, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Height Bands by Birth Sex",
axis.titles = c('Height Bands'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET2 <-
SURVEY %>%
filter( !is.na(HEIGHT2)) %>%
mutate(BIRTHSEX = recode_factor( BIRTHSEX, "M" = "MALES", "F" = "FEMALES", .ordered=T))
ggplot( SUBSET2, aes(x= HEIGHT2)) + facet_grid( SUBSET2$BIRTHSEX ) +
geom_bar(aes(fill= BIRTHSEX) ) +
stat_count(geom="text", aes(label=..count..), vjust= -.3) +
scale_fill_manual( values = c( "MALES"="darkgrey", "FEMALES"="#006cc5"), guide = "none" )+
theme_538() +
xlab("Height Bands")+ ylab("Counts")
#Alternative View, if Birth Sex by Height is desired
CrossTable(SURVEY$HEIGHT2, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r = F, prop.t=F, chisq=T, fisher=F) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 235
##
##
## | SURVEY$BIRTHSEX
## SURVEY$HEIGHT2 | F | M | Row Total |
## ---------------|-----------|-----------|-----------|
## < 5' | 2 | 0 | 2 |
## | 0.018 | 0.000 | |
## ---------------|-----------|-----------|-----------|
## 5-5'3 | 38 | 2 | 40 |
## | 0.339 | 0.016 | |
## ---------------|-----------|-----------|-----------|
## 5'4-5'6 | 46 | 10 | 56 |
## | 0.411 | 0.081 | |
## ---------------|-----------|-----------|-----------|
## 5'7-5'9 | 25 | 41 | 66 |
## | 0.223 | 0.333 | |
## ---------------|-----------|-----------|-----------|
## 5'10-6' | 1 | 44 | 45 |
## | 0.009 | 0.358 | |
## ---------------|-----------|-----------|-----------|
## 6'1-6'4 | 0 | 24 | 24 |
## | 0.000 | 0.195 | |
## ---------------|-----------|-----------|-----------|
## > 6'4 | 0 | 2 | 2 |
## | 0.000 | 0.016 | |
## ---------------|-----------|-----------|-----------|
## Column Total | 112 | 123 | 235 |
## | 0.477 | 0.523 | |
## ---------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 128.2767 d.f. = 6 p = 2.963565e-25
##
##
##
require(ggstatsplot)
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$GLOVE, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Glove Size by Birth Sex",
axis.titles = c('Glove Sizes'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Glove Size is desired
CrossTable(SURVEY$GLOVE, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 231
##
##
## | SURVEY$BIRTHSEX
## SURVEY$GLOVE | F | M | Row Total |
## -------------|-----------|-----------|-----------|
## 5 | 2 | 0 | 2 |
## | 0.018 | 0.000 | |
## -------------|-----------|-----------|-----------|
## 5.5 | 7 | 0 | 7 |
## | 0.064 | 0.000 | |
## -------------|-----------|-----------|-----------|
## 6 | 29 | 0 | 29 |
## | 0.264 | 0.000 | |
## -------------|-----------|-----------|-----------|
## 6.5 | 55 | 6 | 61 |
## | 0.500 | 0.050 | |
## -------------|-----------|-----------|-----------|
## 7 | 15 | 36 | 51 |
## | 0.136 | 0.298 | |
## -------------|-----------|-----------|-----------|
## 7.5 | 2 | 60 | 62 |
## | 0.018 | 0.496 | |
## -------------|-----------|-----------|-----------|
## 8 | 0 | 16 | 16 |
## | 0.000 | 0.132 | |
## -------------|-----------|-----------|-----------|
## 8.5 | 0 | 3 | 3 |
## | 0.000 | 0.025 | |
## -------------|-----------|-----------|-----------|
## Column Total | 110 | 121 | 231 |
## | 0.476 | 0.524 | |
## -------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 159.1027 d.f. = 7 p = 4.954612e-31
##
##
##
#Median Glove Size - Sex Difference
SURVEY %>%
group_by( BIRTHSEX) %>%
summarize( GLOVE_MEDIAN = median(GLOVE, na.rm=T))
## # A tibble: 2 × 2
## BIRTHSEX GLOVE_MEDIAN
## <fct> <dbl>
## 1 F 6.5
## 2 M 7.5
ggbetweenstats( data= SURVEY,
x = BIRTHSEX,
y = GLOVE,
type="nonparametric",
p.adjust.method = "none")
SURVEY %>%
filter( !is.na(GLOVE) ) %>%
ggplot(aes( x=GLOVE, y= stat(density), fill= BIRTHSEX))+
geom_density( alpha=0.5, position = "identity" ) +
scale_x_continuous(breaks = scales::breaks_width(0.5) ) +
scale_y_continuous(breaks = scales::breaks_width(.25))+
scale_fill_manual(values = c("red","darkgreen"), name ="Birth Sex", labels = c("Female","Male"))+
xlab("Glove Size")+ ylab("Density")+
ggtitle("Glove Size Density Curve by Sex", subtitle = "Shows F/M distributions are almost identical, just off by one full size") +
theme_538()
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$PERFORMANCE_HOURS, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Performance Hours by Birth Sex",
axis.titles = c('Performance Hour Bands'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Performance Hours is desired
CrossTable(SURVEY$PERFORMANCE_HOURS, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 235
##
##
## | SURVEY$BIRTHSEX
## SURVEY$PERFORMANCE_HOURS | F | M | Row Total |
## -------------------------|-----------|-----------|-----------|
## < 10 | 26 | 30 | 56 |
## | 0.232 | 0.244 | |
## -------------------------|-----------|-----------|-----------|
## 10-20 | 55 | 55 | 110 |
## | 0.491 | 0.447 | |
## -------------------------|-----------|-----------|-----------|
## 21-30 | 20 | 29 | 49 |
## | 0.179 | 0.236 | |
## -------------------------|-----------|-----------|-----------|
## 31-40 | 8 | 5 | 13 |
## | 0.071 | 0.041 | |
## -------------------------|-----------|-----------|-----------|
## > 40 | 3 | 4 | 7 |
## | 0.027 | 0.033 | |
## -------------------------|-----------|-----------|-----------|
## Column Total | 112 | 123 | 235 |
## | 0.477 | 0.523 | |
## -------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 2.264007 d.f. = 4 p = 0.6873295
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.6885774
##
##
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TEACHER_GENDER_PREFERENCE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Teacher Sex Preference by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Teacher Sex Pref?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#SJPlot cross tabulation with Chi-Square/df
plot_xtab(SURVEY$FEMALE_TRAINERS, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Number of Female Trainers by Birth Sex",
axis.titles = c('Approx. Female Trainers'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Number of Female Trainers is desired
CrossTable(SURVEY$FEMALE_TRAINERS, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 236
##
##
## | SURVEY$BIRTHSEX
## SURVEY$FEMALE_TRAINERS | F | M | Row Total |
## -----------------------|-----------|-----------|-----------|
## None | 2 | 2 | 4 |
## | 0.018 | 0.016 | |
## -----------------------|-----------|-----------|-----------|
## 1-2 | 10 | 12 | 22 |
## | 0.088 | 0.098 | |
## -----------------------|-----------|-----------|-----------|
## 3-5 | 49 | 41 | 90 |
## | 0.434 | 0.333 | |
## -----------------------|-----------|-----------|-----------|
## 6-10 | 41 | 47 | 88 |
## | 0.363 | 0.382 | |
## -----------------------|-----------|-----------|-----------|
## > 10 | 9 | 18 | 27 |
## | 0.080 | 0.146 | |
## -----------------------|-----------|-----------|-----------|
## 11-15 | 2 | 2 | 4 |
## | 0.018 | 0.016 | |
## -----------------------|-----------|-----------|-----------|
## 16-20 | 0 | 1 | 1 |
## | 0.000 | 0.008 | |
## -----------------------|-----------|-----------|-----------|
## Column Total | 113 | 123 | 236 |
## | 0.479 | 0.521 | |
## -----------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 4.887066 d.f. = 6 p = 0.5583774
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.546126
##
##
plot_xtab(SURVEY$MALE_TRAINERS, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Number of Male Trainers by Birth Sex",
axis.titles = c('Approx. Male Trainers'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Number of Male Trainers is desired
CrossTable(SURVEY$MALE_TRAINERS, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 235
##
##
## | SURVEY$BIRTHSEX
## SURVEY$MALE_TRAINERS | F | M | Row Total |
## ---------------------|-----------|-----------|-----------|
## 1-2 | 0 | 2 | 2 |
## | 0.000 | 0.016 | |
## ---------------------|-----------|-----------|-----------|
## 3-5 | 8 | 11 | 19 |
## | 0.071 | 0.090 | |
## ---------------------|-----------|-----------|-----------|
## 6-10 | 53 | 58 | 111 |
## | 0.469 | 0.475 | |
## ---------------------|-----------|-----------|-----------|
## > 10 | 46 | 43 | 89 |
## | 0.407 | 0.352 | |
## ---------------------|-----------|-----------|-----------|
## 11-15 | 6 | 6 | 12 |
## | 0.053 | 0.049 | |
## ---------------------|-----------|-----------|-----------|
## 16-20 | 0 | 1 | 1 |
## | 0.000 | 0.008 | |
## ---------------------|-----------|-----------|-----------|
## 21-25 | 0 | 1 | 1 |
## | 0.000 | 0.008 | |
## ---------------------|-----------|-----------|-----------|
## Column Total | 113 | 122 | 235 |
## | 0.481 | 0.519 | |
## ---------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 4.461897 d.f. = 6 p = 0.6144274
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.767432
##
##
#SJPlot cross tabulation with Chi-Square/df
plot_xtab( SURVEY$BIRTHSEX, SURVEY$EXPERIENCED_TRANSIENT_PAIN_HAND, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Transient Pain in Hand after Procedure by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Hand Pain?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Transient Pain in Neck/Shoulder after Procedure by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Neck/Should Pain?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX,SURVEY$EXPERIENCED_TRANSIENT_PAIN_BACK, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Transient Pain in Back after Procedure by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Back Pain?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$EXPERIENCED_TRANSIENT_PAIN_LEG, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Transient Pain in Leg after Procedure by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Leg Pain?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$EXPERIENCED_TRANSIENT_PAIN_FOOT, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Transient Pain in Foot after Procedure by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Foot Pain?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#SJPlot cross tabulation with Chi-Square/df
SUBSET <- sqldf( "select BIRTHSEX,
GROWING_PAINS
from SURVEY
where GROWING_PAINS != 'NA' ")
SUBSET <- SUBSET %>%
mutate(GROWING_PAINS = recode_factor( GROWING_PAINS, "N" = "N",
"Y" = "Y")) %>% droplevels()
plot_xtab(SUBSET$BIRTHSEX, SUBSET$GROWING_PAINS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Told Injuries were Growing Pains by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Growing Pains?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$FELLOWSHIP_FORMAL_ERGO_TRAINING, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Formal Ergo Training by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Formal Ergo Traiing?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab( SURVEY$BIRTHSEX, SURVEY$INFORMAL_TRAINING,margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Informal Ergo Training by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Informal Ergo Training?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_POSTURAL, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Postural Awareness by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Postural Awareness?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_BEDHEIGHT, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Bed Height Adjustments by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Bed Height?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_BEDANGLE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Bed Angle Adjustments by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Bed Angle?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_MONITORHEIGHT, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Monitor Height Adjustments by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Monitor Height?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_MUSCULOSKELETAL, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Musculoskeletal Maneuvers by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Musculoskeletal?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_EXERCISE_STRETCHING, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Exercise/Stretching by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Exer/Stretch?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab( SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_DIAL_EXTENDERS,margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Dial Extenders by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Training Dial Ext?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TRAINING_TECHNIQUES_PEDIATRIC_COLONOSCOPE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Training on Pediatric Colonoscopes by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Traiing Pedi Coloscope?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$ERGO_TRAINING_BUDGET, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Ergonomic Training Budget by Birth Sex",
axis.titles = c('Ergonomic Training Budget?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Ergo Training Budget is desired
CrossTable(SURVEY$ERGO_TRAINING_BUDGET, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 236
##
##
## | SURVEY$BIRTHSEX
## SURVEY$ERGO_TRAINING_BUDGET | F | M | Row Total |
## ----------------------------|-----------|-----------|-----------|
## Y | 2 | 0 | 2 |
## | 0.018 | 0.000 | |
## ----------------------------|-----------|-----------|-----------|
## N | 30 | 34 | 64 |
## | 0.265 | 0.276 | |
## ----------------------------|-----------|-----------|-----------|
## DK | 81 | 89 | 170 |
## | 0.717 | 0.724 | |
## ----------------------------|-----------|-----------|-----------|
## Column Total | 113 | 123 | 236 |
## | 0.479 | 0.521 | |
## ----------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 2.206704 d.f. = 2 p = 0.3317572
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.5002872
##
##
plot_xtab(SURVEY$ERGO_FEEDBACK, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Ergo Feedback Frequency by Birth Sex",
axis.titles = c('How Frequently Ergo Feedback?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Ergo Feedback Frequency is desired
CrossTable(SURVEY$ERGO_FEEDBACK, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 236
##
##
## | SURVEY$BIRTHSEX
## SURVEY$ERGO_FEEDBACK | F | M | Row Total |
## ---------------------|-----------|-----------|-----------|
## Never | 2 | 4 | 6 |
## | 0.018 | 0.033 | |
## ---------------------|-----------|-----------|-----------|
## Rarely | 37 | 46 | 83 |
## | 0.327 | 0.374 | |
## ---------------------|-----------|-----------|-----------|
## Sometimes | 57 | 61 | 118 |
## | 0.504 | 0.496 | |
## ---------------------|-----------|-----------|-----------|
## Often | 17 | 12 | 29 |
## | 0.150 | 0.098 | |
## ---------------------|-----------|-----------|-----------|
## Column Total | 113 | 123 | 236 |
## | 0.479 | 0.521 | |
## ---------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 2.22049 d.f. = 3 p = 0.5279237
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.548075
##
##
plot_xtab(SURVEY$ERGO_FEEDBACK_BY_WHOM, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Who Provides Ergo Feedback by Birth Sex",
axis.titles = c('Who Provides Feedback?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Ergo Feedback by Whom is desired
CrossTable(SURVEY$ERGO_FEEDBACK_BY_WHOM, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 236
##
##
## | SURVEY$BIRTHSEX
## SURVEY$ERGO_FEEDBACK_BY_WHOM | F | M | Row Total |
## --------------------------------|-----------|-----------|-----------|
## Do not/rarely received feedback | 15 | 22 | 37 |
## | 0.133 | 0.179 | |
## --------------------------------|-----------|-----------|-----------|
## Mostly male teachers | 17 | 22 | 39 |
## | 0.150 | 0.179 | |
## --------------------------------|-----------|-----------|-----------|
## Mostly female teachers | 20 | 16 | 36 |
## | 0.177 | 0.130 | |
## --------------------------------|-----------|-----------|-----------|
## Both equally | 61 | 63 | 124 |
## | 0.540 | 0.512 | |
## --------------------------------|-----------|-----------|-----------|
## Column Total | 113 | 123 | 236 |
## | 0.479 | 0.521 | |
## --------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 2.021954 d.f. = 3 p = 0.5678626
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.5778785
##
##
plot_xtab( SURVEY$BIRTHSEX, SURVEY$ERGO_OPTIMIZATION, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Ergonomically Optimized Equipment by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Ergo Optimization?",
geom.colors = c("#006cc5", "lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$GLOVE_SIZE_AVAILABLE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Glove Size Availability by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Glove Size Avail?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$DIAL_EXTENDERS_AVAILABLE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Dial Extender Availability by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Dial Ext Avail?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET <- sqldf( "select BIRTHSEX,
DIAL_EXTENDERS_ENCOURAGED
from SURVEY
where DIAL_EXTENDERS_ENCOURAGED != 'DU' ")
SUBSET <- SUBSET %>%
mutate(DIAL_EXTENDERS_ENCOURAGED = recode_factor( DIAL_EXTENDERS_ENCOURAGED, "N" = "N",
"Y" = "Y")) %>% droplevels()
plot_xtab(SUBSET$BIRTHSEX, SUBSET$DIAL_EXTENDERS_ENCOURAGED, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Dial Extenders Encouraged by Birth Sex - (Includes only subjects who use Dial Extenders)",
axis.titles = "Birth Sex",
legend.title= "Dial Ext Encouraged?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET <- sqldf( "select BIRTHSEX,
DIAL_EXTENDERS_FEMALEATT
from SURVEY
where DIAL_EXTENDERS_FEMALEATT != 'NA' ")
SUBSET <- SUBSET %>%
mutate(DIAL_EXTENDERS_FEMALEATT = recode_factor( DIAL_EXTENDERS_FEMALEATT, "N" = "N",
"Y" = "Y")) %>% droplevels()
plot_xtab(SUBSET$BIRTHSEX, SUBSET$DIAL_EXTENDERS_FEMALEATT, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Dial Extenders Encouraged with Female Att by Birth Sex - (Includes only subjects who use Dial Extenders)",
axis.titles = "Birth Sex",
legend.title= "Dial Ext FemAtt?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET <- sqldf( "select BIRTHSEX,
DIAL_EXTENDERS_MALEATT
from SURVEY
where DIAL_EXTENDERS_MALEATT != 'NA' ")
SUBSET <- SUBSET %>%
mutate(DIAL_EXTENDERS_MALEATT = recode_factor( DIAL_EXTENDERS_MALEATT, "N" = "N",
"Y" = "Y")) %>% droplevels()
plot_xtab(SUBSET$BIRTHSEX, SUBSET$DIAL_EXTENDERS_MALEATT, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Dial Extenders Encouraged with Male Att by Birth Sex - (Includes only subjects who use Dial Extenders)",
axis.titles = "Birth Sex",
legend.title= "Dial Ext MaleAtt?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$PEDI_COLONOSCOPES_AVAILABLE, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Pediatric Colonoscopes by Birth Sex",
axis.titles = c('Pedi Colonoscopes Available?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Pedi Colonoscopes is desired
CrossTable(SURVEY$PEDI_COLONOSCOPES_AVAILABLE, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 235
##
##
## | SURVEY$BIRTHSEX
## SURVEY$PEDI_COLONOSCOPES_AVAILABLE | F | M | Row Total |
## -----------------------------------|-----------|-----------|-----------|
## Y | 107 | 122 | 229 |
## | 0.955 | 0.992 | |
## -----------------------------------|-----------|-----------|-----------|
## N | 2 | 0 | 2 |
## | 0.018 | 0.000 | |
## -----------------------------------|-----------|-----------|-----------|
## DK | 3 | 1 | 4 |
## | 0.027 | 0.008 | |
## -----------------------------------|-----------|-----------|-----------|
## Column Total | 112 | 123 | 235 |
## | 0.477 | 0.523 | |
## -----------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 3.475254 d.f. = 2 p = 0.1759374
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.1735968
##
##
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_DONTKNOW, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Don't Know Whether Lead Aprons Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Aware of Lead Aprons?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab( SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_LW_ONEPIECE,margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons LW One-Piece Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons LW 1P?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_LW_TWOPIECE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons LW Two-Piece Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons LW 2P?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_STANDARD_ONEPIECE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons SW One-Piece Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons Std 1P?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_STANDARD_TWOPIECE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons SW Two-Piece Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons Std 2P?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_DOUBLE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons Double Lead (Maternity) Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons Double?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_THYROID, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons Thyroid Shield Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons Thyroid?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_MATERNALDOS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons Maternal Dosimeter Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons Maternal?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$LEAD_APRONS_FETALDOS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Lead Aprons Fetal Dosimeter Available at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Lead Aprons Fetal?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$ERGO_FORMAL_TIMEOUT_PRIOR, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Formal Ergo Timeouts at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Formal Ergo Timeout?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$ERGO_INFORMAL_TIMEOUT_PRIOR, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Informal Ergo Timeouts at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Informal Ergo Timeout?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab( SURVEY$BIRTHSEX, SURVEY$MONITORS_ADJUSTABLE,margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Monitors Easily Adjustable at Institution by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Monitors Easily Adjust?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TEACHER_SENSITIVITY_STATURE_HANDSIZE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Teachers Train with Sensitivity to Stature/Hand Size by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Teacher Sensitivity to Stature?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$TEACHER_SENSITIVITY_BY_GENDER, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Sex of Sensitive Teachers by Birth Sex",
axis.titles = c('Male or Female Teachers More Sensitive?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Male or Female Teacher more Sensitive is desired
CrossTable(SURVEY$TEACHER_SENSITIVITY_BY_GENDER, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 234
##
##
## | SURVEY$BIRTHSEX
## SURVEY$TEACHER_SENSITIVITY_BY_GENDER | F | M | Row Total |
## -------------------------------------|-----------|-----------|-----------|
## Male | 8 | 8 | 16 |
## | 0.071 | 0.066 | |
## -------------------------------------|-----------|-----------|-----------|
## Female | 23 | 10 | 33 |
## | 0.205 | 0.082 | |
## -------------------------------------|-----------|-----------|-----------|
## Both Equally | 55 | 72 | 127 |
## | 0.491 | 0.590 | |
## -------------------------------------|-----------|-----------|-----------|
## Never had female teacher | 3 | 2 | 5 |
## | 0.027 | 0.016 | |
## -------------------------------------|-----------|-----------|-----------|
## Not Sure | 23 | 30 | 53 |
## | 0.205 | 0.246 | |
## -------------------------------------|-----------|-----------|-----------|
## Column Total | 112 | 122 | 234 |
## | 0.479 | 0.521 | |
## -------------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 8.108789 d.f. = 4 p = 0.08767341
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.07838717
##
##
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TACTILE_INSTRUCTION_FROM_MALES, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Tactile Instruction from Male Teachers by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Tactile Instruction from Males?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$TACTILE_INSTRUCTION_FROM_FEMALES, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Tactile Instruction from Females Teachers by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Tactile Instruction from Females?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$COMFORTABLE_ASKING_NURSES, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Comfortable Asking Nurses for Help by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Comfortable Asking Nurses?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
SUBSET <- sqldf( "select BIRTHSEX,
COMFORTABLE_ASKING_TECHS
from SURVEY
where COMFORTABLE_ASKING_TECHS != 'NA' ")
SUBSET <- SUBSET %>%
mutate(COMFORTABLE_ASKING_TECHS = recode_factor( COMFORTABLE_ASKING_TECHS, "N" = "N",
"Y" = "Y")) %>% droplevels()
plot_xtab(SUBSET$BIRTHSEX, SUBSET$COMFORTABLE_ASKING_TECHS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Comfortable Asking Techs for Help by Birth Sex (Includes only respondents with Techs)",
axis.titles = "Birth Sex",
legend.title= "Comfortable Asking Techs?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab( SURVEY$BIRTHSEX, SURVEY$NURSES_ASKING, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Times Asking Nurses for Help by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Times Asking Nurses?",
geom.colors = c("#006cc5", "lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$MALE_ATTENDINGS_ASKING, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Times Male Attending Asking Nurses for Help by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Times Asking MaleAtt?",
geom.colors = c("#006cc5", "lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$FEMALE_ATTENDINGS_ASKING, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Times Female Attending Asking Nurses for Help by Birth Sex",
axis.titles = c('Times Female Att Asking Nurses?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Times Asking Female Attending is desired
CrossTable(SURVEY$FEMALE_ATTENDINGS_ASKING, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 229
##
##
## | SURVEY$BIRTHSEX
## SURVEY$FEMALE_ATTENDINGS_ASKING | F | M | Row Total |
## --------------------------------|-----------|-----------|-----------|
## Once | 42 | 51 | 93 |
## | 0.389 | 0.421 | |
## --------------------------------|-----------|-----------|-----------|
## Twice | 25 | 32 | 57 |
## | 0.231 | 0.264 | |
## --------------------------------|-----------|-----------|-----------|
## More than Twice | 37 | 36 | 73 |
## | 0.343 | 0.298 | |
## --------------------------------|-----------|-----------|-----------|
## Don't work with FemAtt | 4 | 2 | 6 |
## | 0.037 | 0.017 | |
## --------------------------------|-----------|-----------|-----------|
## Column Total | 108 | 121 | 229 |
## | 0.472 | 0.528 | |
## --------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 1.6784 d.f. = 3 p = 0.6417466
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.6522275
##
##
plot_xtab(SURVEY$BIRTHSEX, SURVEY$RECOGNIZED_RESPECTED_ES_STAFF, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Recognized/Respected by ES Staff by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Recog by ES Staff?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$RECOGNIZED_RESPECTED_ANESTHETISTS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Recognized/Respected by Anesthetists by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Recog by Anesthetists?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab( SURVEY$BIRTHSEX, SURVEY$RECOGNIZED_RESPECTED_GASTRO_ATTENDING,margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Recognized/Respected by Gastro Attending by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Recog by Gastro Att?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$FIRST_NAME_NO_PERMISSION, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "First Name Used No Permission by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "First Name No Permission?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Is there a RACE difference on this question ?
plot_xtab(SURVEY$RACE2, SURVEY$FIRST_NAME_NO_PERMISSION, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "First Name Used No Permission by Race (Broad)",
axis.titles = "Binary Race Category",
legend.title= "First Name Used No Permission?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Is there a TRAINING LEVEL difference on this question ?
plot_xtab(SURVEY$TRAINING_LEVEL, SURVEY$FIRST_NAME_NO_PERMISSION, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "First Name Used No Permission by Training Level",
axis.titles = "Binary Race Category",
legend.title= "First Name Used No Permission?",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$ERGO_TRAINING_MANDATORY, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Should Ergo Training be Mandaotry by Birth Sex",
axis.titles = c('Mandatory Ergo Training?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Ergo Training be Mandatory is desired
CrossTable(SURVEY$ERGO_TRAINING_MANDATORY, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F , prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 234
##
##
## | SURVEY$BIRTHSEX
## SURVEY$ERGO_TRAINING_MANDATORY | F | M | Row Total |
## -------------------------------|-----------|-----------|-----------|
## Y | 112 | 116 | 228 |
## | 0.991 | 0.959 | |
## -------------------------------|-----------|-----------|-----------|
## N | 0 | 2 | 2 |
## | 0.000 | 0.017 | |
## -------------------------------|-----------|-----------|-----------|
## DK | 1 | 3 | 4 |
## | 0.009 | 0.025 | |
## -------------------------------|-----------|-----------|-----------|
## Column Total | 113 | 121 | 234 |
## | 0.483 | 0.517 | |
## -------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 2.799944 d.f. = 2 p = 0.2466039
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.3718787
##
##
plot_xtab(SURVEY$ERGO_OPTIMIZAITON_BUDGET_REQUIRED, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Should Budget Include Ergo Optimiation by Birth Sex",
axis.titles = c('Budget Should Include Ergo Opti?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Ergo Optimization Budget be Mandatory is desired
CrossTable(SURVEY$ERGO_OPTIMIZAITON_BUDGET_REQUIRED, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 233
##
##
## | SURVEY$BIRTHSEX
## SURVEY$ERGO_OPTIMIZAITON_BUDGET_REQUIRED | F | M | Row Total |
## -----------------------------------------|-----------|-----------|-----------|
## Y | 109 | 106 | 215 |
## | 0.965 | 0.883 | |
## -----------------------------------------|-----------|-----------|-----------|
## N | 0 | 3 | 3 |
## | 0.000 | 0.025 | |
## -----------------------------------------|-----------|-----------|-----------|
## DK | 4 | 11 | 15 |
## | 0.035 | 0.092 | |
## -----------------------------------------|-----------|-----------|-----------|
## Column Total | 113 | 120 | 233 |
## | 0.485 | 0.515 | |
## -----------------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 6.103736 d.f. = 2 p = 0.04727055
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.04412296
##
##
plot_xtab(SURVEY$BIRTHSEX, SURVEY$EXPERIENCE_IMPROVED_DIAL_EXTENDERS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Increased Availability of Dial Extenders by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Increase Avail Dial Ext?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$EXPERIENCE_IMPROVED_PEDI_COLONOSCOPES, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Increased Availability of Pedi Colonoscopes by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Increase Avail Pediscopes?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$EXPERIENCE_IMPROVED_APRONS, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Increased Availability of Lead Aprons by Birth Sex",
axis.titles = "Birth Sex",
legend.title= "Improve Aprons?",
geom.colors = c("#006cc5","lightblue", "#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED, SURVEY$BIRTHSEX, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Formal Ergo Training Required for Teachers by Birth Sex",
axis.titles = c('Ergo Training Required for Teachers?'),
legend.title= "Birth Sex",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
#Alternative View, if Birth Sex by Formal Teacher Training Mandatory is desired
CrossTable(SURVEY$ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=T, fisher=T) #rows then/over columns
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 234
##
##
## | SURVEY$BIRTHSEX
## SURVEY$ENDO_TEACHERS_FORMAL_TRAINING_REQUIRED | F | M | Row Total |
## ----------------------------------------------|-----------|-----------|-----------|
## Y | 103 | 105 | 208 |
## | 0.912 | 0.868 | |
## ----------------------------------------------|-----------|-----------|-----------|
## N | 1 | 4 | 5 |
## | 0.009 | 0.033 | |
## ----------------------------------------------|-----------|-----------|-----------|
## DK | 9 | 12 | 21 |
## | 0.080 | 0.099 | |
## ----------------------------------------------|-----------|-----------|-----------|
## Column Total | 113 | 121 | 234 |
## | 0.483 | 0.517 | |
## ----------------------------------------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 1.976608 d.f. = 2 p = 0.3722074
##
##
##
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p = 0.4698464
##
##
plot_xtab(SURVEY$BIRTHSEX, SURVEY$ERGONOMIC_IMPORTANCE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Importance of Ergonomics in Relation to ERI",
axis.titles = "Birth Sex",
legend.title= "Ergo Importance Response",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$MITIGATING_MUSCLE_STRAIN, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Mitigation Strategies to Reduce Muscle Strain Risk",
axis.titles = "Birth Sex",
legend.title= "Muscle Strain Response",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$BED_POSITION, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Bed Position in Relation to the Elbow",
axis.titles = "Birth Sex",
legend.title= "Bed Position Response",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$ENDO_TRAINER_POSITION, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Best Position for Endoscopy Trainer",
axis.titles = "Birth Sex",
legend.title= "Trainer Position Response",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
plot_xtab(SURVEY$BIRTHSEX, SURVEY$WHEN_DISABILITY_INSURANCE, margin = "row",
bar.pos = "stack", coord.flip = TRUE,
title = "Best Time to Explore Disability Insurance",
axis.titles = "Birth Sex",
legend.title= "When Disab Ins Response",
geom.colors = c("#006cc5","#cbcccb"),
show.summary = TRUE )+
set_theme(base= theme_classic())
# CORRECT <-
#
# SURVEY %>%
# mutate(CORRECT = across(.cols = ERGONOMIC_IMPORTANCE: WHEN_DISABILITY_INSURANCE , .fns = str_count, "Correct")) %>%
# rowwise() %>%
# mutate(COUNT_CORRECT = across(.cols = contains("Correct"), .fns = sum)) %>%
# select (BIRTHSEX, ERGONOMIC_IMPORTANCE: WHEN_DISABILITY_INSURANCE, COUNT_CORRECT) %>%
# mutate( COUNT_CORRECT = as.integer(COUNT_CORRECT) )
# CORRECT <-
# SURVEY %>%
# select (BIRTHSEX, ERGONOMIC_IMPORTANCE: WHEN_DISABILITY_INSURANCE,) %>%
# mutate( COUNT_CORRECT = apply( . , 1, function(x) sum( x== "Correct", na.rm= T )))
CORRECT <-
SURVEY %>%
select (BIRTHSEX, ERGONOMIC_IMPORTANCE: WHEN_DISABILITY_INSURANCE,) %>%
mutate( COUNT_CORRECT = rowSums( . == "Correct" ))
eov.ttest(CORRECT, COUNT_CORRECT, BIRTHSEX)
## [1] "F Test p.value = 0.4348913 EOV = TRUE (Pooled)"
## [1] "CORRECT : COUNT_CORRECT ~ BIRTHSEX"
##
## Two Sample t-test
##
## data: CORRECT : COUNT_CORRECT ~ BIRTHSEX
## t = 1.2623, df = 234, p-value = 0.2081
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -0.1096219 0.5005853
## sample estimates:
## mean in group F mean in group M
## 3.504425 3.308943
ggbetweenstats( data= CORRECT,
x = BIRTHSEX,
y = COUNT_CORRECT,
type="parametric",
p.adjust.method = "none",
title = "Mean Scores by Birth Sex")
The appropriate tack here would be to run a series of “point
biserial correlations,” which are correlations between a categorical
data (structured as T/F, 0/1, or ordinal, such as Low-Medium-High or
Freshman-Sophomore-Junior-Senior) against a continuous
variable. In our data, the only continuous variable is
GLOVE (glove size), so therefore, only the correlations where our
demographic categorical data is compared to GLOVE (e.g., BIRTHSEX,
AGEBAND, TRNG_LEVEL, HEIGHT_BAND) are statistically valid. For other
categorical variables that we have coerced into a binary numeric –
EVER_INJURED, TRANSIENT_PAIN_XXXX, ERGO_OPTIM – any correlations against
other categorical variables would technically be statistically
inappropriate to run, and should certainly never be reported. For our
purposes here, these “correlations” should be used only to guide us to
perform other, more appropriate statistical tests (such as logistic
regression, which is a natural extension of the Chi-Square analyses run
previously).
CORRMATRIX <-
SURVEY %>%
select (BIRTHSEX, RACE2, AGE2, TRAINING_LEVEL, HEIGHT2, GLOVE, EVER_INJURED, ERGO_OPTIMIZATION, TEACHER_SENSITIVITY_STATURE_HANDSIZE,
FIRST_NAME_NO_PERMISSION, EXPERIENCED_TRANSIENT_PAIN_HAND : EXPERIENCED_TRANSIENT_PAIN_FOOT ) %>%
# na.omit() %>%
mutate( SEX = case_when( is.na(BIRTHSEX) ~ NA_real_,
BIRTHSEX == "M" ~ 0,
TRUE ~ 1 ) ,
RACE = case_when( is.na(RACE2) ~ NA_real_,
RACE2 == "WHITE" ~ 0,
TRUE ~ 1),
AGECAT = case_when( is.na(AGE2) ~ NA_real_,
AGE2 == "< 30" ~ 1,
AGE2 == "30-34" ~ 2,
AGE2 == "35-40" ~3,
TRUE ~ 4),
TRNG_LEVEL = case_when( is.na(TRAINING_LEVEL) ~ NA_real_,
TRAINING_LEVEL == 'First Year' ~ 1,
TRAINING_LEVEL == 'Second Year' ~ 2,
TRAINING_LEVEL == 'Third Year' ~ 3,
TRUE ~ 4) ,
HEIGHT = case_when( is.na(HEIGHT2) ~ NA_real_,
HEIGHT2 == "< 5" ~ 1,
HEIGHT2 == "5-5'3" ~ 2,
HEIGHT2 == "5'4-5'6" ~ 3,
HEIGHT2 == "5'7-5'9" ~ 4,
HEIGHT2 == "5'10-6'" ~ 5,
HEIGHT2 == "6'1-6'4" ~ 6,
TRUE ~ 7),
INJURY = case_when( is.na(EVER_INJURED) ~ NA_real_,
EVER_INJURED== "Y" ~ 1,
TRUE ~ 0) ,
TPAIN = case_when( is.na(EXPERIENCED_TRANSIENT_PAIN_BACK) |
is.na(EXPERIENCED_TRANSIENT_PAIN_HAND) |
is.na(EXPERIENCED_TRANSIENT_PAIN_FOOT) |
is.na(EXPERIENCED_TRANSIENT_PAIN_HAND) |
is.na(EXPERIENCED_TRANSIENT_PAIN_LEG) |
is.na(EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER) ~ NA_real_,
EXPERIENCED_TRANSIENT_PAIN_BACK == "Y" |
EXPERIENCED_TRANSIENT_PAIN_HAND == "Y" |
EXPERIENCED_TRANSIENT_PAIN_FOOT == "Y" |
EXPERIENCED_TRANSIENT_PAIN_HAND == "Y" |
EXPERIENCED_TRANSIENT_PAIN_LEG == "Y" |
EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER == "Y" ~ 1,
TRUE ~ 0),
ERGO_OPTIM = case_when( is.na(ERGO_OPTIMIZATION) ~ NA_real_,
ERGO_OPTIMIZATION == "Y" ~ 1,
TRUE ~ 0),
SENSITIVE_TEACHER = case_when (is.na(TEACHER_SENSITIVITY_STATURE_HANDSIZE) ~ NA_real_,
TEACHER_SENSITIVITY_STATURE_HANDSIZE == "Y" ~ 1,
TRUE ~ 0),
FNAME_NP = case_when (is.na(FIRST_NAME_NO_PERMISSION) ~ NA_real_,
FIRST_NAME_NO_PERMISSION == "Y" ~ 1,
TRUE ~ 0)) %>%
select( SEX, RACE, AGECAT, TRNG_LEVEL, HEIGHT, GLOVE, INJURY, TPAIN, ERGO_OPTIM, SENSITIVE_TEACHER, FNAME_NP)
pairs.panels( CORRMATRIX, pch=21, stars=T,)
require(ppcor)
## Loading required package: ppcor
#Partial Correlation: HEIGHT + INJURY correlation adjusted for SEX and then RACE
CORRMATRIX_NOMISS <- CORRMATRIX %>% na.omit()
attach(CORRMATRIX_NOMISS)
pcor.test( x=HEIGHT, y=INJURY, z=SEX, method= 'pearson')
## estimate p.value statistic n gp Method
## 1 0.03588903 0.5931306 0.5350792 225 1 pearson
pcor.test( x=HEIGHT, y=INJURY, z=RACE, method= 'pearson' )
## estimate p.value statistic n gp Method
## 1 0.04481562 0.5045668 0.6684092 225 1 pearson
#Partial Correlation: GLOVE + INJURY correlation adjusted for SEX and then RACE
pcor.test( x=GLOVE, y=INJURY, z=SEX, method= 'pearson' )
## estimate p.value statistic n gp Method
## 1 -0.02094146 0.7552657 -0.3120891 225 1 pearson
pcor.test( x=GLOVE, y=INJURY, z=RACE, method= 'pearson' )
## estimate p.value statistic n gp Method
## 1 0.006639589 0.9212833 0.09892982 225 1 pearson
detach(CORRMATRIX_NOMISS)
#Ergonomic Difficulty during Pregnancy?
CrossTable(SURVEY$PREGNANCY_ERGO_DIFFICULTY, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=F, fisher=F)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 23
##
##
## | SURVEY$BIRTHSEX
## SURVEY$PREGNANCY_ERGO_DIFFICULTY | F | M | Row Total |
## ---------------------------------|-----------|-----------|-----------|
## N | 9 | 0 | 9 |
## | 0.391 | NaN | |
## ---------------------------------|-----------|-----------|-----------|
## Y | 14 | 0 | 14 |
## | 0.609 | NaN | |
## ---------------------------------|-----------|-----------|-----------|
## Column Total | 23 | 0 | 23 |
## | 1.000 | 0.000 | |
## ---------------------------------|-----------|-----------|-----------|
##
##
CrossTable(SURVEY$PREGNANCY_ERGO_INJURY, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=F, fisher=F)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 22
##
##
## | SURVEY$BIRTHSEX
## SURVEY$PREGNANCY_ERGO_INJURY | F | M | Row Total |
## -----------------------------|-----------|-----------|-----------|
## N | 21 | 0 | 21 |
## | 0.955 | NaN | |
## -----------------------------|-----------|-----------|-----------|
## Y | 1 | 0 | 1 |
## | 0.045 | NaN | |
## -----------------------------|-----------|-----------|-----------|
## Column Total | 22 | 0 | 22 |
## | 1.000 | 0.000 | |
## -----------------------------|-----------|-----------|-----------|
##
##
CrossTable(SURVEY$POSTPARTUM_ERGO_INJURY, SURVEY$BIRTHSEX, prop.chisq=F, prop.c=T, prop.r=F, prop.t=F, chisq=F, fisher=F)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Col Total |
## |-------------------------|
##
##
## Total Observations in Table: 20
##
##
## | SURVEY$BIRTHSEX
## SURVEY$POSTPARTUM_ERGO_INJURY | F | M | Row Total |
## ------------------------------|-----------|-----------|-----------|
## N | 19 | 0 | 19 |
## | 0.950 | NaN | |
## ------------------------------|-----------|-----------|-----------|
## Y | 1 | 0 | 1 |
## | 0.050 | NaN | |
## ------------------------------|-----------|-----------|-----------|
## Column Total | 20 | 0 | 20 |
## | 1.000 | 0.000 | |
## ------------------------------|-----------|-----------|-----------|
##
##
#Correlation Matrix to view "associations" with Glove Size and Height
PREGNANCY <-
SURVEY %>%
filter( FELLOWSHIP_PREGNANCY == "Y") %>%
select (BIRTHSEX, RACE2, AGE2, TRAINING_LEVEL, HEIGHT2, GLOVE, PREGNANCY_ERGO_DIFFICULTY ) %>%
mutate( SEX = case_when( is.na(BIRTHSEX) ~ NA_real_,
BIRTHSEX == "M" ~ 0,
TRUE ~ 1 ) ,
RACE = case_when( is.na(RACE2) ~ NA_real_,
RACE2 == "WHITE" ~ 0,
TRUE ~ 1),
AGECAT = case_when( is.na(AGE2) ~ NA_real_,
AGE2 == "< 30" ~ 1,
AGE2 == "30-34" ~ 2,
AGE2 == "35-40" ~3,
TRUE ~ 4),
TRNG_LEVEL = case_when( is.na(TRAINING_LEVEL) ~ NA_real_,
TRAINING_LEVEL == 'First Year' ~ 1,
TRAINING_LEVEL == 'Second Year' ~ 2,
TRAINING_LEVEL == 'Third Year' ~ 3,
TRUE ~ 4) ,
HEIGHT = case_when( is.na(HEIGHT2) ~ NA_real_,
HEIGHT2 == "< 5" ~ 1,
HEIGHT2 == "5-5'3" ~ 2,
HEIGHT2 == "5'4-5'6" ~ 3,
HEIGHT2 == "5'7-5'9" ~ 4,
HEIGHT2 == "5'10-6'" ~ 5,
HEIGHT2 == "6'1-6'4" ~ 6,
TRUE ~ 7),
ERGO_DIFF = case_when( is.na(PREGNANCY_ERGO_DIFFICULTY) ~ NA_real_,
PREGNANCY_ERGO_DIFFICULTY == 'N' ~ 0,
TRUE ~ 1) ) %>%
select( SEX, RACE, AGECAT, TRNG_LEVEL, ERGO_DIFF, GLOVE, HEIGHT)
pairs.panels( PREGNANCY[c(-1,-2)] , pch=21, stars=T)
require(ggcorrplot)
## Loading required package: ggcorrplot
#Paneled Correlation Matrices for each level of "Training Level" (4)
CORRMATRIX %>%
mutate(TRNG_LEVEL = factor(TRNG_LEVEL),
TRNG_LEVEL = recode_factor(TRNG_LEVEL, '1'= 'First Yr', '2'= "Second Yr", '3'= "Third Yr", '4'="Advanced", .ordered=T)) %>%
select(TRNG_LEVEL, ERGO_OPTIM, INJURY, TPAIN, SENSITIVE_TEACHER, FNAME_NP) %>%
grouped_ggcorrmat(
## arguments relevant for `ggcorrmat`
data = . ,
grouping.var = TRNG_LEVEL,
## arguments relevant for `combine_plots`
plotgrid.args = list(nrow = 2),
annotation.args = list(
tag_levels = "1",
title = "Relationship among Key Variables across Training Level"
),
p.adjust.method = "none"
)
Let’s explore further with few unadjusted/adjusted regressions where Transient Pain is the outcome and Ergo Optimization is the outcome:
require(car)
TLEVEL <-
CORRMATRIX %>%
mutate(TRNG_LEVEL = factor(TRNG_LEVEL),
TRNG_LEVEL = recode_factor(TRNG_LEVEL, '1'= 'First Yr', '2'= "Second Yr", '3'= "Third Yr", '4'="Advanced", .ordered=F),
TRNG_LEVEL = relevel(TRNG_LEVEL, ref= "Advanced")) %>%
select(TRNG_LEVEL, ERGO_OPTIM, INJURY, TPAIN, SENSITIVE_TEACHER, FNAME_NP)
tpain.eo.glm.unadj <- glm( TPAIN ~ ERGO_OPTIM, data= TLEVEL, family= binomial(link="logit"))
tpain.eo.emmeans.unadj <- emmeans( tpain.eo.glm.unadj, ~ c(ERGO_OPTIM), type= "response")
tpain.eo.glm.adj <- glm( TPAIN ~ ERGO_OPTIM + TRNG_LEVEL, data= TLEVEL, family= binomial(link="logit"))
tpain.eo.emmeans.adj <- emmeans( tpain.eo.glm.adj, ~ c(ERGO_OPTIM), type= "response")
summary(tpain.eo.glm.unadj)
##
## Call:
## glm(formula = TPAIN ~ ERGO_OPTIM, family = binomial(link = "logit"),
## data = TLEVEL)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3678 0.3536 0.3536 0.4173 0.6085
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.7408 0.3263 8.401 <2e-16 ***
## ERGO_OPTIM -1.1482 0.4547 -2.525 0.0116 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 146.29 on 235 degrees of freedom
## Residual deviance: 139.96 on 234 degrees of freedom
## AIC: 143.96
##
## Number of Fisher Scoring iterations: 5
contrast(tpain.eo.emmeans.unadj, list("Unadj OR: Ergo Optim =Y on Transient Pain =Y" = c(-1, 1)))
## contrast odds.ratio SE df null z.ratio
## Unadj OR: Ergo Optim =Y on Transient Pain =Y 0.317 0.144 Inf 1 -2.525
## p.value
## 0.0116
##
## Tests are performed on the log odds ratio scale
contrast(tpain.eo.emmeans.unadj, list("Unadj OR: Ergo Optim =N on Transient Pain =Y" = c(1, -1)))
## contrast odds.ratio SE df null z.ratio
## Unadj OR: Ergo Optim =N on Transient Pain =Y 3.15 1.43 Inf 1 2.525
## p.value
## 0.0116
##
## Tests are performed on the log odds ratio scale
summary(tpain.eo.glm.adj)
##
## Call:
## glm(formula = TPAIN ~ ERGO_OPTIM + TRNG_LEVEL, family = binomial(link = "logit"),
## data = TLEVEL)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5034 0.2984 0.3197 0.4984 0.8232
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.0230 0.7462 2.711 0.00671 **
## ERGO_OPTIM -1.1149 0.4649 -2.398 0.01647 *
## TRNG_LEVELFirst Yr 0.4247 0.7675 0.553 0.58003
## TRNG_LEVELSecond Yr 1.0661 0.8205 1.299 0.19381
## TRNG_LEVELThird Yr 0.9250 0.8206 1.127 0.25964
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 146.09 on 234 degrees of freedom
## Residual deviance: 137.16 on 230 degrees of freedom
## (1 observation deleted due to missingness)
## AIC: 147.16
##
## Number of Fisher Scoring iterations: 5
#Before running OR test, determine whether the multilevel categorical variable TRNG_LEVEL is significant overall?
aod::wald.test(b = coef(tpain.eo.glm.adj), Sigma = vcov(tpain.eo.glm.adj), Terms = 3:5)
## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 2.5, df = 3, P(> X2) = 0.48
contrast(tpain.eo.emmeans.adj, list("Adj OR: Ergo Optim =N on Transient Pain =Y" = c(1, -1)))
## contrast odds.ratio SE df null z.ratio
## Adj OR: Ergo Optim =N on Transient Pain =Y 3.05 1.42 Inf 1 2.398
## p.value
## 0.0165
##
## Results are averaged over the levels of: TRNG_LEVEL
## Tests are performed on the log odds ratio scale
tpain.steach.glm.unadj <- glm( TPAIN ~ SENSITIVE_TEACHER, data= TLEVEL, family= binomial(link="logit"))
tpain.steach.emmeans.unadj <- emmeans( tpain.steach.glm.unadj, ~ c(SENSITIVE_TEACHER), type= "response")
tpain.steach.glm.adj <- glm( TPAIN ~ SENSITIVE_TEACHER + TRNG_LEVEL, data= TLEVEL, family= binomial(link="logit"))
tpain.steach.emmeans.adj <- emmeans( tpain.steach.glm.adj, ~ c(SENSITIVE_TEACHER), type= "response")
summary(tpain.steach.glm.unadj)
##
## Call:
## glm(formula = TPAIN ~ SENSITIVE_TEACHER, family = binomial(link = "logit"),
## data = TLEVEL)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3126 0.3780 0.3780 0.5026 0.5026
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.6027 0.3664 7.103 1.22e-12 ***
## SENSITIVE_TEACHER -0.5974 0.4640 -1.287 0.198
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 145.89 on 233 degrees of freedom
## Residual deviance: 144.18 on 232 degrees of freedom
## (2 observations deleted due to missingness)
## AIC: 148.18
##
## Number of Fisher Scoring iterations: 5
contrast(tpain.steach.emmeans.unadj, list("Unadj OR: Sensitive Teach =Y on Transient Pain =Y" = c(-1, 1)))
## contrast odds.ratio SE df null
## Unadj OR: Sensitive Teach =Y on Transient Pain =Y 0.55 0.255 Inf 1
## z.ratio p.value
## -1.287 0.1980
##
## Tests are performed on the log odds ratio scale
contrast(tpain.steach.emmeans.unadj, list("Unadj OR: Sensitive Teach =N on Transient Pain =Y" = c(1, -1)))
## contrast odds.ratio SE df null
## Unadj OR: Sensitive Teach =N on Transient Pain =Y 1.82 0.843 Inf 1
## z.ratio p.value
## 1.287 0.1980
##
## Tests are performed on the log odds ratio scale
summary(tpain.steach.glm.adj)
##
## Call:
## glm(formula = TPAIN ~ SENSITIVE_TEACHER + TRNG_LEVEL, family = binomial(link = "logit"),
## data = TLEVEL)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4822 0.3067 0.4080 0.4531 0.8498
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.5247 0.6804 2.241 0.0250 *
## SENSITIVE_TEACHER -0.6920 0.4792 -1.444 0.1487
## TRNG_LEVELFirst Yr 0.9197 0.7624 1.206 0.2277
## TRNG_LEVELSecond Yr 1.5089 0.8129 1.856 0.0634 .
## TRNG_LEVELThird Yr 1.3921 0.8216 1.694 0.0902 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 145.69 on 232 degrees of freedom
## Residual deviance: 140.18 on 228 degrees of freedom
## (3 observations deleted due to missingness)
## AIC: 150.18
##
## Number of Fisher Scoring iterations: 5
#Before running OR test, determine whether the multilevel categorical variable TRNG_LEVEL is significant overall?
aod::wald.test(b = coef(tpain.steach.glm.adj), Sigma = vcov(tpain.steach.glm.adj), Terms = 3:5)
## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 4.1, df = 3, P(> X2) = 0.25
contrast(tpain.steach.emmeans.adj, list("Adj OR: Sensitive Teach =N on Transient Pain =Y" = c(1, -1)))
## contrast odds.ratio SE df null
## Adj OR: Sensitive Teach =N on Transient Pain =Y 2 0.957 Inf 1
## z.ratio p.value
## 1.444 0.1487
##
## Results are averaged over the levels of: TRNG_LEVEL
## Tests are performed on the log odds ratio scale
eo.steach.glm.unadj <- glm( ERGO_OPTIM ~ SENSITIVE_TEACHER, data= TLEVEL, family= binomial(link="logit"))
eo.steach.emmeans.unadj <- emmeans( eo.steach.glm.unadj, ~ c(SENSITIVE_TEACHER), type= "response")
eo.steach.glm.adj <- glm( ERGO_OPTIM ~ SENSITIVE_TEACHER + TRNG_LEVEL, data= TLEVEL, family= binomial(link="logit"))
eo.steach.emmeans.adj <- emmeans( eo.steach.glm.adj, ~ c(SENSITIVE_TEACHER), type= "response")
summary(eo.steach.glm.unadj)
##
## Call:
## glm(formula = ERGO_OPTIM ~ SENSITIVE_TEACHER, family = binomial(link = "logit"),
## data = TLEVEL)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.0080 -1.0080 -0.6809 1.3569 1.7751
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.3437 0.2292 -5.863 4.56e-09 ***
## SENSITIVE_TEACHER 0.9312 0.2965 3.141 0.00168 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 287.23 on 233 degrees of freedom
## Residual deviance: 276.94 on 232 degrees of freedom
## (2 observations deleted due to missingness)
## AIC: 280.94
##
## Number of Fisher Scoring iterations: 4
contrast(eo.steach.emmeans.unadj, list("Unadj OR: Sensitive Teach =Y on Ergo Optim =Y" = c(-1, 1)))
## contrast odds.ratio SE df null
## Unadj OR: Sensitive Teach =Y on Ergo Optim =Y 2.54 0.752 Inf 1
## z.ratio p.value
## 3.141 0.0017
##
## Tests are performed on the log odds ratio scale
contrast(eo.steach.emmeans.unadj, list("Unadj OR: Sensitive Teach =N on Ergo Optim =Y" = c(1, -1)))
## contrast odds.ratio SE df null
## Unadj OR: Sensitive Teach =N on Ergo Optim =Y 0.394 0.117 Inf 1
## z.ratio p.value
## -3.141 0.0017
##
## Tests are performed on the log odds ratio scale
summary(eo.steach.glm.adj)
##
## Call:
## glm(formula = ERGO_OPTIM ~ SENSITIVE_TEACHER + TRNG_LEVEL, family = binomial(link = "logit"),
## data = TLEVEL)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1833 -0.9466 -0.6308 1.3515 1.8931
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.01384 0.55807 0.025 0.980213
## SENSITIVE_TEACHER 1.03915 0.31117 3.340 0.000839 ***
## TRNG_LEVELFirst Yr -1.62345 0.62676 -2.590 0.009591 **
## TRNG_LEVELSecond Yr -1.52756 0.62137 -2.458 0.013957 *
## TRNG_LEVELThird Yr -1.45344 0.63211 -2.299 0.021485 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 284.83 on 232 degrees of freedom
## Residual deviance: 267.99 on 228 degrees of freedom
## (3 observations deleted due to missingness)
## AIC: 277.99
##
## Number of Fisher Scoring iterations: 4
#Before running OR test, determine whether the multilevel categorical variable TRNG_LEVEL is significant overall?
aod::wald.test(b = coef(eo.steach.glm.adj), Sigma = vcov(eo.steach.glm.adj), Terms = 3:5)
## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 7.0, df = 3, P(> X2) = 0.07
contrast(eo.steach.emmeans.adj, list("Adj OR: Sensitive Teach =Y on Ergo Optim =Y" = c(-1, 1)))
## contrast odds.ratio SE df null z.ratio
## Adj OR: Sensitive Teach =Y on Ergo Optim =Y 2.83 0.88 Inf 1 3.340
## p.value
## 0.0008
##
## Results are averaged over the levels of: TRNG_LEVEL
## Tests are performed on the log odds ratio scale
Conclusion: Sensitive Teacher is a highly significant effect before, and an extremely highly significant effect after adjusting for Training Level. Training Level itself is not a significant effect. (The model summary shows that there is significance among three levels of TRNG_LEVEL *when compared to the reference category, “Advanced.”) Beta for ST increases slightly from +0.9312 to +1.03915, meaning that as Teacher Sensitivity increases, reports of Ergonomic Optimization also rise. (The Odds Ratio in the adjusted model rose from 2.54 to 2.83, p= 0.0008. In other words, subjects who reported that their Endoscopy Suite environment was ergonomically optimized were 2.83 times more likely to have had instructors who were sensitive to their physical size/stature.)
When compared to the reference category (“Advanced”), ALL other training levels were significantly different (i.e., lower Beta weights). Does this suggest that teachers are more likely to be sensitive to ergonomics when dealing with older trainees, or does it suggest that younger trainees don’t really know what proper ergonomics should entail and, therefore, don’t know how to rate their instructors on this metric? (Does it take rising to the Advanced level before a trainee fully understands what constitutes “proper ergonomics?”)
4. First Name-No Permission does not appear to be correlated with Sex, but there does appear to be some correlation to Height Band. Is it significant?
# Since height is a multilevel categorical variable, use the median Male height as the reference, 5, or 5'10-6'
FNAME <-
CORRMATRIX %>%
select( SEX, AGECAT, RACE, HEIGHT, TRNG_LEVEL, FNAME_NP) %>%
mutate( HEIGHT = factor(HEIGHT),
HEIGHT = relevel(HEIGHT, ref="5"),
AGECAT = recode_factor(AGECAT, '1'='1', '2'='1', '3'='2', '4'='2'),
AGECAT = relevel(AGECAT, ref="2"))
levels(FNAME$HEIGHT)
## [1] "5" "2" "3" "4" "6" "7"
levels(FNAME$AGECAT)
## [1] "2" "1"
fname.height.glm.unadj <- glm( FNAME_NP ~ HEIGHT, data= FNAME, family= binomial(link="logit"))
fname.height.emmeans.unadj <- emmeans( fname.height.glm.unadj, ~ c(HEIGHT), type= "response")
fname.height.glm.adj <- glm( FNAME_NP ~ HEIGHT + SEX , data= FNAME, family= binomial(link="logit"))
fname.height.emmeans.adj <- emmeans( fname.height.glm.adj, ~ c(HEIGHT, SEX), type= "response")
summary(fname.height.glm.unadj)
##
## Call:
## glm(formula = FNAME_NP ~ HEIGHT, family = binomial(link = "logit"),
## data = FNAME)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1774 -0.8806 -0.7090 1.3349 2.0184
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.2528 0.3586 -3.494 0.000476 ***
## HEIGHT2 0.8899 0.4843 1.837 0.066151 .
## HEIGHT3 0.5055 0.4587 1.102 0.270446
## HEIGHT4 0.1335 0.4599 0.290 0.771534
## HEIGHT6 -0.6444 0.7155 -0.901 0.367800
## HEIGHT7 1.2528 1.0623 1.179 0.238300
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 275.21 on 231 degrees of freedom
## Residual deviance: 266.71 on 226 degrees of freedom
## (4 observations deleted due to missingness)
## AIC: 278.71
##
## Number of Fisher Scoring iterations: 4
contrast(fname.height.emmeans.unadj, list("Unadj OR: Height2 (5-5'3) on FNAME_NP =Y relative to 5'10-6'" = c(-1, 1, 0, 0, 0, 0)))
## contrast odds.ratio SE
## Unadj OR: Height2 (5-5'3) on FNAME_NP =Y relative to 5'10-6' 2.43 1.18
## df null z.ratio p.value
## Inf 1 1.837 0.0662
##
## Tests are performed on the log odds ratio scale
contrast(fname.height.emmeans.unadj, list("Unadj OR: Height3 (5'4-5'6) on FNAME_NP =Y relative to 5'10-6'" = c(-1, 0, 1, 0, 0, 0)))
## contrast odds.ratio
## Unadj OR: Height3 (5'4-5'6) on FNAME_NP =Y relative to 5'10-6' 1.66
## SE df null z.ratio p.value
## 0.761 Inf 1 1.102 0.2704
##
## Tests are performed on the log odds ratio scale
contrast(fname.height.emmeans.unadj, list("Unadj OR: Height4 (5'7-5'9) on FNAME_NP =Y relative to 5'10-6'" = c(-1, 0, 0, 1, 0, 0)))
## contrast odds.ratio
## Unadj OR: Height4 (5'7-5'9) on FNAME_NP =Y relative to 5'10-6' 1.14
## SE df null z.ratio p.value
## 0.526 Inf 1 0.290 0.7715
##
## Tests are performed on the log odds ratio scale
contrast(fname.height.emmeans.unadj, list("Unadj OR: Height6 (6'-6'4) on FNAME_NP =Y relative to 5'10-6'" = c(-1, 0, 0, 0, 1, 0)))
## contrast odds.ratio SE
## Unadj OR: Height6 (6'-6'4) on FNAME_NP =Y relative to 5'10-6' 0.525 0.376
## df null z.ratio p.value
## Inf 1 -0.901 0.3678
##
## Tests are performed on the log odds ratio scale
contrast(fname.height.emmeans.unadj, list("Unadj OR: Height7 (< 6'4) on FNAME_NP =Y relative to 5'10-6'" = c(-1, 0, 0, 0, 0, 1)))
## contrast odds.ratio SE
## Unadj OR: Height7 (< 6'4) on FNAME_NP =Y relative to 5'10-6' 3.5 3.72
## df null z.ratio p.value
## Inf 1 1.179 0.2383
##
## Tests are performed on the log odds ratio scale
#Determine whether the multilevel categorical variable HEIGHT is significant overall in the UNADJUSTED model?
aod::wald.test(b = coef(fname.height.glm.unadj), Sigma = vcov(fname.height.glm.unadj), Terms = 2:6)
## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 8.0, df = 5, P(> X2) = 0.16
summary(fname.height.glm.adj)
##
## Call:
## glm(formula = FNAME_NP ~ HEIGHT + SEX, family = binomial(link = "logit"),
## data = FNAME)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.1905 -0.8766 -0.7094 1.3363 2.0184
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.25141 0.35869 -3.489 0.000485 ***
## HEIGHT2 0.94709 0.62448 1.517 0.129369
## HEIGHT3 0.55483 0.57039 0.973 0.330686
## HEIGHT4 0.15571 0.48414 0.322 0.747744
## HEIGHT6 -0.64571 0.71553 -0.902 0.366838
## HEIGHT7 1.28229 1.08178 1.185 0.235877
## SEX -0.06176 0.42540 -0.145 0.884565
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 275.21 on 231 degrees of freedom
## Residual deviance: 266.69 on 225 degrees of freedom
## (4 observations deleted due to missingness)
## AIC: 280.69
##
## Number of Fisher Scoring iterations: 4
#summary(fname.height.emmeans.adj)
#Determine whether the multilevel categorical variable HEIGHT is significant overall in the ADJUSTED model?
aod::wald.test(b = coef(fname.height.glm.adj), Sigma = vcov(fname.height.glm.adj), Terms = 2:6)
## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 5.3, df = 5, P(> X2) = 0.38
# Just for fun, adjust only for SEX
fname.sex.glm.unadj <- glm( FNAME_NP ~ SEX , data= FNAME, family= binomial(link="logit"))
fname.sex.emmeans.unadj <- emmeans( fname.sex.glm.unadj, ~ c(SEX), type= "response")
summary(fname.sex.glm.unadj)
##
## Call:
## glm(formula = FNAME_NP ~ SEX, family = binomial(link = "logit"),
## data = FNAME)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8956 -0.8956 -0.7255 1.4883 1.7109
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.2004 0.2156 -5.569 2.57e-08 ***
## SEX 0.4938 0.2947 1.676 0.0938 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 275.86 on 232 degrees of freedom
## Residual deviance: 273.03 on 231 degrees of freedom
## (3 observations deleted due to missingness)
## AIC: 277.03
##
## Number of Fisher Scoring iterations: 4
#Confirm that Sex is not significant (trend with 0.10 > p-value > 0.05)
aod::wald.test(b = coef(fname.sex.glm.unadj), Sigma = vcov(fname.sex.glm.unadj), Terms = 2:2)
## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 2.8, df = 1, P(> X2) = 0.094
contrast(fname.sex.emmeans.unadj, list("Unadj OR: Females vs. Males FNAME_NP =Y" = c(-1, 1)))
## contrast odds.ratio SE df null z.ratio
## Unadj OR: Females vs. Males FNAME_NP =Y 1.64 0.483 Inf 1 1.676
## p.value
## 0.0938
##
## Tests are performed on the log odds ratio scale
#Use sjPlots to display resutls for all three models side-by-side: Height Only, Height + Sex, Sex Only
tab_model(fname.height.glm.unadj, fname.height.glm.adj, fname.sex.glm.unadj, title= "First Name - No Permission Logistic Models <br> ([Model 1] Height Only <> [Model 2] Height + Sex <> [Model 3] Sex Only) <br>.")
| FNAME_NP | FNAME_NP | FNAME_NP | |||||||
|---|---|---|---|---|---|---|---|---|---|
| Predictors | Odds Ratios | CI | p | Odds Ratios | CI | p | Odds Ratios | CI | p |
| (Intercept) | 0.29 | 0.13 – 0.56 | <0.001 | 0.29 | 0.13 – 0.56 | <0.001 | 0.30 | 0.19 – 0.45 | <0.001 |
| HEIGHT [2] | 2.43 | 0.95 – 6.46 | 0.066 | 2.58 | 0.76 – 8.93 | 0.129 | |||
| HEIGHT [3] | 1.66 | 0.68 – 4.19 | 0.270 | 1.74 | 0.57 – 5.41 | 0.331 | |||
| HEIGHT [4] | 1.14 | 0.47 – 2.89 | 0.772 | 1.17 | 0.45 – 3.08 | 0.748 | |||
| HEIGHT [6] | 0.53 | 0.11 – 1.96 | 0.368 | 0.52 | 0.11 – 1.95 | 0.367 | |||
| HEIGHT [7] | 3.50 | 0.38 – 32.36 | 0.238 | 3.60 | 0.38 – 34.46 | 0.236 | |||
| SEX | 0.94 | 0.41 – 2.18 | 0.885 | 1.64 | 0.92 – 2.94 | 0.094 | |||
| Observations | 232 | 232 | 233 | ||||||
| R2 Tjur | 0.036 | 0.036 | 0.012 | ||||||
Conclusion: When compared to the median Male height (HEIGHT=5, or 5’10-6’), the odds of the subjects’ first name being used without permission decreases as the reference height is approached. Subjects who were taller, however, had mixed results: Ones who were one band above the reference height (6’-6’4), had reduced odds of being disrespected in this manner; but the tallest subjects (HEIGHT=7, or > 6’4) had the worst odds ratio of all, 3.5, a group that is singularly comprised of males (n=2). Unfortunately, none of these results was statistically significant.
Even after adjusting for SEX, the significance of HEIGHT in the model did not improve (in fact, it worsened, likely because the variables HEIGHT and SEX are highly correlated). An unadjusetd model where SEX replaced HEIGHT as the predictor variable, yielded good results, but still not significant (p= 0.0938). Adjusting for RACE (not shown) did not improve the model.
PAIN <-
SURVEY %>%
mutate( BIRTHSEX2 = case_when( BIRTHSEX == "M" ~ 0,
TRUE ~ 1 ),
PAIN_INJ = case_when (EVER_INJURED == 'Y' ~ 1,
TRUE ~ 0 ),
PAIN_HAND = case_when (EXPERIENCED_TRANSIENT_PAIN_HAND == "Y" ~ 1,
TRUE ~ 0),
PAIN_NECK = case_when (EXPERIENCED_TRANSIENT_PAIN_NECK_SHOULDER == "Y" ~ 1,
TRUE ~ 0),
PAIN_BACK = case_when (EXPERIENCED_TRANSIENT_PAIN_BACK == "Y" ~ 1,
TRUE ~ 0),
PAIN_LEG = case_when (EXPERIENCED_TRANSIENT_PAIN_LEG == "Y" ~ 1,
TRUE ~ 0),
PAIN_FOOT = case_when (EXPERIENCED_TRANSIENT_PAIN_FOOT == "Y" ~ 1,
TRUE ~ 0)) %>%
rowwise() %>%
mutate(PAIN_SCORE = sum(PAIN_INJ+ PAIN_HAND+ PAIN_NECK+ PAIN_BACK + PAIN_LEG+ PAIN_FOOT)) %>%
select( RECORD_ID, BIRTHSEX, BIRTHSEX2, RACE, RACE2, TRAINING_LEVEL, EVER_INJURED, starts_with("PAIN_") )
# Test for normality of distribution (will be sensitive to outliers)
shapiro.test(PAIN$PAIN_SCORE)
##
## Shapiro-Wilk normality test
##
## data: PAIN$PAIN_SCORE
## W = 0.89272, p-value = 6.5e-12
# Group Means & Standard Deviations
PAIN %>%
group_by(BIRTHSEX) %>%
summarize( PAINMEAN = mean(PAIN_SCORE),
PAINSD = sd(PAIN_SCORE))
## # A tibble: 2 × 3
## BIRTHSEX PAINMEAN PAINSD
## <fct> <dbl> <dbl>
## 1 F 2.27 1.39
## 2 M 1.76 1.33
# Welch's T-test
eov.ttest(PAIN, PAIN_SCORE, BIRTHSEX)
## [1] "F Test p.value = 0.6449448 EOV = TRUE (Pooled)"
## [1] "PAIN : PAIN_SCORE ~ BIRTHSEX"
##
## Two Sample t-test
##
## data: PAIN : PAIN_SCORE ~ BIRTHSEX
## t = 2.8305, df = 234, p-value = 0.005051
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## 0.1523617 0.8501565
## sample estimates:
## mean in group F mean in group M
## 2.265487 1.764228
# Violin Plot to explore differences between sexes
ggbetweenstats( data= PAIN,
x = BIRTHSEX,
y = PAIN_SCORE,
type="parametric",
p.adjust.method = "none",
title = "Mean Pain/Injury Scores by Birth Sex")
PAIN %>%
ggplot(aes( x= PAIN_SCORE, y= stat(density), fill= BIRTHSEX))+
geom_density( alpha=0.5, position = "identity" ) +
scale_x_continuous(breaks = scales::breaks_width(1.0) ) +
scale_y_continuous(breaks = scales::breaks_width(.1))+
scale_fill_manual(values = c("red","darkgreen"), name ="Birth Sex", labels = c("Female","Male"))+
xlab("Pain Score")+ ylab("Density")+
ggtitle("Pain Score Density Curve by Sex") +
theme_538()
corr.test( PAIN$BIRTHSEX2,PAIN$PAIN_SCORE, method= 'pearson')
## Call:corr.test(x = PAIN$BIRTHSEX2, y = PAIN$PAIN_SCORE, method = "pearson")
## Correlation matrix
## [1] 0.18
## Sample Size
## [1] 236
## These are the unadjusted probability values.
## The probability values adjusted for multiple tests are in the p.adj object.
## [1] 0.01
##
## To see confidence intervals of the correlations, print with the short=FALSE option
# CREATE TRAINING INDEX
TRAINING <-
SURVEY %>%
mutate( BIRTHSEX2 = case_when( BIRTHSEX == "M" ~ 0,
TRUE ~ 1 ),
TRNG_FORMAL = case_when (FELLOWSHIP_FORMAL_ERGO_TRAINING == 'Y' ~ 1,
TRUE ~ 0 ),
TRNG_INFORMAL = case_when (INFORMAL_TRAINING == "Y" ~ 1,
TRUE ~ 0),
TRNG_POSTURAL = case_when (TRAINING_TECHNIQUES_POSTURAL == "Y" ~ 1,
TRUE ~ 0),
TRNG_BEDHT = case_when (TRAINING_TECHNIQUES_BEDHEIGHT == "Y" ~ 1,
TRUE ~ 0),
TRNG_BEDANG = case_when (TRAINING_TECHNIQUES_BEDANGLE == "Y" ~ 1,
TRUE ~ 0),
TRNG_MONITOR = case_when (TRAINING_TECHNIQUES_MONITORHEIGHT == "Y" ~ 1,
TRUE ~ 0),
TRNG_MANEUVERS = case_when (TRAINING_TECHNIQUES_MUSCULOSKELETAL == "Y" ~ 1,
TRUE ~ 0) ,
TRNG_EXERCISE = case_when (TRAINING_TECHNIQUES_EXERCISE_STRETCHING == "Y" ~ 1,
TRUE ~ 0),
TRNG_DIALEXT= case_when (TRAINING_TECHNIQUES_DIAL_EXTENDERS == "Y" ~ 1,
TRUE ~ 0),
TRNG_PEDISCOPE= case_when (TRAINING_TECHNIQUES_PEDIATRIC_COLONOSCOPE == "Y" ~ 1,
TRUE ~ 0),
TRNG_FEEDBACK= case_when (ERGO_FEEDBACK == "Often" ~ 3,
ERGO_FEEDBACK == "Sometimes" ~ 2,
ERGO_FEEDBACK == "Rarely" ~ 1,
TRUE ~ 0),
TRNG_OPTIM= case_when (ERGO_OPTIMIZATION == "Y" ~ 1,
ERGO_OPTIMIZATION == "N" ~ 0,
TRUE ~ 0),
TRNG_GLOVE_AVAIL = case_when (GLOVE_SIZE_AVAILABLE == "Y" ~ 1,
TRUE ~ 0),
TRNG_DIALEXT_AVAIL= case_when (DIAL_EXTENDERS_AVAILABLE == "Y" ~ 1,
TRUE ~ 0),
TRNG_DIALEXT_ENC= case_when (DIAL_EXTENDERS_ENCOURAGED == "Y" ~ 1,
TRUE ~ 0),
TRNG_PEDISCOPE_AVAIL = case_when (PEDI_COLONOSCOPES_AVAILABLE == "Y" ~ 1,
TRUE ~ 0),
TRNG_FITTED_APRON_AVAIL = case_when (LEAD_APRONS_DONTKNOW == "Aware" ~ 1,
TRUE ~ 0),
TRNG_TO_FORMAL= case_when (ERGO_FORMAL_TIMEOUT_PRIOR == "Y" ~ 1,
TRUE ~ 0),
TRNG_TO_INFORMAL= case_when (ERGO_INFORMAL_TIMEOUT_PRIOR == "Y" ~ 1,
TRUE ~ 0),
TRNG_MONITORS_EASYADJ = case_when (MONITORS_ADJUSTABLE == "Y" ~ 1,
TRUE ~ 0),
TRNG_TRAINERS_SENSITIVITY = case_when (TEACHER_SENSITIVITY_STATURE_HANDSIZE == "Y" ~ 1,
TRUE ~ 0),
TRNG_TACTILE_MALES = case_when (TACTILE_INSTRUCTION_FROM_MALES == "Often" ~ 2,
TACTILE_INSTRUCTION_FROM_MALES == "Rarely" ~ 1,
TRUE ~ 0),
TRNG_TACTILE_FEMALES = case_when (TACTILE_INSTRUCTION_FROM_FEMALES == "Often" ~ 2,
TACTILE_INSTRUCTION_FROM_FEMALES == "Rarely" ~ 1,
TRUE ~ 0)) %>%
rowwise() %>%
mutate(RECORD_ID, TRNG_SCORE = sum(TRNG_FORMAL+ TRNG_INFORMAL+ TRNG_POSTURAL+ TRNG_BEDHT+ +TRNG_BEDANG+ TRNG_MONITOR+ TRNG_MANEUVERS+ TRNG_EXERCISE+ TRNG_DIALEXT+
TRNG_PEDISCOPE+ TRNG_FEEDBACK+ TRNG_OPTIM+ TRNG_GLOVE_AVAIL+ TRNG_DIALEXT_AVAIL+ TRNG_DIALEXT_ENC+ TRNG_PEDISCOPE_AVAIL+
TRNG_FITTED_APRON_AVAIL+ TRNG_TO_FORMAL+ TRNG_TO_INFORMAL+ TRNG_MONITORS_EASYADJ + TRNG_TRAINERS_SENSITIVITY+
TRNG_TACTILE_MALES+ TRNG_TACTILE_FEMALES)) %>%
select( BIRTHSEX, BIRTHSEX2, RACE, RACE2, TRAINING_LEVEL, starts_with("TRNG_") )
TRAINING %>%
group_by(BIRTHSEX) %>%
summarize( TRNGMEAN = mean(TRNG_SCORE),
TRNGSD = sd(TRNG_SCORE))
## # A tibble: 2 × 3
## BIRTHSEX TRNGMEAN TRNGSD
## <fct> <dbl> <dbl>
## 1 F 14.3 4.32
## 2 M 14.3 3.82
shapiro.test(TRAINING$TRNG_SCORE)
##
## Shapiro-Wilk normality test
##
## data: TRAINING$TRNG_SCORE
## W = 0.98663, p-value = 0.02634
eov.ttest(TRAINING, TRNG_SCORE, BIRTHSEX)
## [1] "F Test p.value = 0.1854427 EOV = TRUE (Pooled)"
## [1] "TRAINING : TRNG_SCORE ~ BIRTHSEX"
##
## Two Sample t-test
##
## data: TRAINING : TRNG_SCORE ~ BIRTHSEX
## t = 0.14512, df = 234, p-value = 0.8847
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -0.9663353 1.1200154
## sample estimates:
## mean in group F mean in group M
## 14.34513 14.26829
ggbetweenstats( data= TRAINING,
x = BIRTHSEX,
y = TRNG_SCORE,
type="parametric",
p.adjust.method = "none",
title = "Mean Training Scores by Birth Sex")
corr.test( TRAINING$BIRTHSEX2,TRAINING$TRNG_SCORE, method= 'pearson', ci=T)
## Call:corr.test(x = TRAINING$BIRTHSEX2, y = TRAINING$TRNG_SCORE, method = "pearson",
## ci = T)
## Correlation matrix
## [1] 0.01
## Sample Size
## [1] 236
## These are the unadjusted probability values.
## The probability values adjusted for multiple tests are in the p.adj object.
## [1] 0.88
##
## To see confidence intervals of the correlations, print with the short=FALSE option
# BIRTHSEX predicting PAIN_SCORE
summary(lm(PAIN_SCORE ~ BIRTHSEX , data = SCORES))
##
## Call:
## lm(formula = PAIN_SCORE ~ BIRTHSEX, data = SCORES)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2655 -0.7642 -0.2655 0.7345 4.2358
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.2655 0.1278 17.720 < 2e-16 ***
## BIRTHSEXM -0.5013 0.1771 -2.831 0.00505 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.359 on 234 degrees of freedom
## Multiple R-squared: 0.0331, Adjusted R-squared: 0.02897
## F-statistic: 8.012 on 1 and 234 DF, p-value: 0.005051
# BIRTHSEX predicting PAIN_SCORE when controlled for EQUIP_SCORE
summary(lm(PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE , data = SCORES))
##
## Call:
## lm(formula = PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE, data = SCORES)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6223 -0.8577 -0.2891 0.6593 3.9757
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.95550 0.30318 9.748 <2e-16 ***
## BIRTHSEXM -0.43139 0.17734 -2.433 0.0157 *
## EQUIP_SCORE -0.16661 0.06654 -2.504 0.0130 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.344 on 233 degrees of freedom
## Multiple R-squared: 0.05844, Adjusted R-squared: 0.05036
## F-statistic: 7.231 on 2 and 233 DF, p-value: 0.0008978
# BIRTHSEX predicting PAIN_SCORE when controlled for EQUIP_SCORE & AGEBAND
summary(lm(PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE + AGE2 , data = SCORES))
##
## Call:
## lm(formula = PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE + AGE2, data = SCORES)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5508 -0.8632 -0.2636 0.6211 4.1679
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.38271 0.41479 5.744 2.91e-08 ***
## BIRTHSEXM -0.39608 0.17825 -2.222 0.02725 *
## EQUIP_SCORE -0.17189 0.06606 -2.602 0.00987 **
## AGE230-34 0.68375 0.32965 2.074 0.03918 *
## AGE235-40 0.36111 0.39134 0.923 0.35710
## AGE2> 40 -1.12716 1.37320 -0.821 0.41259
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.333 on 230 degrees of freedom
## Multiple R-squared: 0.08639, Adjusted R-squared: 0.06653
## F-statistic: 4.35 on 5 and 230 DF, p-value: 0.0008409
anova(lm(PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE + AGE2 , data = SCORES))
## Analysis of Variance Table
##
## Response: PAIN_SCORE
## Df Sum Sq Mean Sq F value Pr(>F)
## BIRTHSEX 1 14.80 14.7978 8.3341 0.004261 **
## EQUIP_SCORE 1 11.33 11.3257 6.3787 0.012223 *
## AGE2 3 12.49 4.1637 2.3450 0.073689 .
## Residuals 230 408.38 1.7756
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# COMPARE how M/F PAIN_SCORE means differ in unadjusted and fully adjusted model
library(emmeans)
#unadjusted model
pscore.unadj <- emmeans(lm(PAIN_SCORE ~ BIRTHSEX , data = SCORES), specs= "BIRTHSEX")
summary(pscore.unadj)
## BIRTHSEX emmean SE df lower.CL upper.CL
## F 2.27 0.128 234 2.01 2.52
## M 1.76 0.123 234 1.52 2.01
##
## Confidence level used: 0.95
contrast(pscore.unadj, list(FvM = c(1,-1)))
## contrast estimate SE df t.ratio p.value
## FvM 0.501 0.177 234 2.831 0.0051
#fully adjusted model
pscore.adj <- emmeans(lm(PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE + AGE2 , data = SCORES), specs= "BIRTHSEX")
summary(pscore.adj)
## BIRTHSEX emmean SE df lower.CL upper.CL
## F 1.61 0.367 230 0.89 2.34
## M 1.22 0.353 230 0.52 1.91
##
## Results are averaged over the levels of: AGE2
## Confidence level used: 0.95
contrast(pscore.adj, list(FvM = c(1,-1)))
## contrast estimate SE df t.ratio p.value
## FvM 0.396 0.178 230 2.222 0.0273
##
## Results are averaged over the levels of: AGE2
#Compare all combinations of BIRTHSEX-AGE2 to see if any sliver is significantly different (after Benjamini-Hochberg correction for multiple comparisons)
pscore.adj2 <- emmeans(lm(PAIN_SCORE ~ BIRTHSEX + EQUIP_SCORE + AGE2 , data = SCORES), specs= c("BIRTHSEX","AGE2"))
summary(pscore.adj2)
## BIRTHSEX AGE2 emmean SE df lower.CL upper.CL
## F < 30 1.633 0.325 230 0.993 2.27
## M < 30 1.237 0.329 230 0.589 1.89
## F 30-34 2.317 0.132 230 2.057 2.58
## M 30-34 1.921 0.134 230 1.657 2.18
## F 35-40 1.994 0.261 230 1.481 2.51
## M 35-40 1.598 0.235 230 1.136 2.06
## F > 40 0.506 1.344 230 -2.142 3.15
## M > 40 0.110 1.333 230 -2.517 2.74
##
## Confidence level used: 0.95
pairs(pscore.adj2, adjust="bh", type="response")
## contrast estimate SE df t.ratio p.value
## F < 30 - M < 30 0.3961 0.178 230 2.222 0.1272
## F < 30 - (F 30-34) -0.6838 0.330 230 -2.074 0.1371
## F < 30 - (M 30-34) -0.2877 0.372 230 -0.773 0.4929
## F < 30 - (F 35-40) -0.3611 0.391 230 -0.923 0.4761
## F < 30 - (M 35-40) 0.0350 0.412 230 0.085 0.9324
## F < 30 - F > 40 1.1272 1.373 230 0.821 0.4929
## F < 30 - M > 40 1.5232 1.373 230 1.109 0.4240
## M < 30 - (F 30-34) -1.0798 0.377 230 -2.860 0.1272
## M < 30 - (M 30-34) -0.6838 0.330 230 -2.074 0.1371
## M < 30 - (F 35-40) -0.7572 0.448 230 -1.691 0.2826
## M < 30 - (M 35-40) -0.3611 0.391 230 -0.923 0.4761
## M < 30 - F > 40 0.7311 1.396 230 0.524 0.6473
## M < 30 - M > 40 1.1272 1.373 230 0.821 0.4929
## (F 30-34) - (M 30-34) 0.3961 0.178 230 2.222 0.1272
## (F 30-34) - (F 35-40) 0.3226 0.252 230 1.282 0.3756
## (F 30-34) - (M 35-40) 0.7187 0.286 230 2.515 0.1272
## (F 30-34) - F > 40 1.8109 1.339 230 1.352 0.3756
## (F 30-34) - M > 40 2.2070 1.340 230 1.647 0.2826
## (M 30-34) - (F 35-40) -0.0734 0.330 230 -0.223 0.8543
## (M 30-34) - (M 35-40) 0.3226 0.252 230 1.282 0.3756
## (M 30-34) - F > 40 1.4148 1.362 230 1.039 0.4422
## (M 30-34) - M > 40 1.8109 1.339 230 1.352 0.3756
## (F 35-40) - (M 35-40) 0.3961 0.178 230 2.222 0.1272
## (F 35-40) - F > 40 1.4883 1.353 230 1.100 0.4240
## (F 35-40) - M > 40 1.8844 1.359 230 1.387 0.3756
## (M 35-40) - F > 40 1.0922 1.371 230 0.797 0.4929
## (M 35-40) - M > 40 1.4883 1.353 230 1.100 0.4240
## F > 40 - M > 40 0.3961 0.178 230 2.222 0.1272
##
## P value adjustment: BH method for 28 tests
#FINDING:
#In the fully-adjusted model, of the 28 possible SEX/AGEBAND combinations, the one that is statistically significant - and survives a correction for multiple comparisons - is "Males < 30" versus "Females 30-34." Here the Females' mean is 1.327 points higher than the Males', p=0.0292. (The F-M differential for entire adjusted model was only 0.388 points.)
#Since Females 30-34 have the highest adjusted Pain Score, how does that score compare to the mean Pain Score of ALL OTHER RESPONDENTS?
# Mean for Females 30-34
contrast( pscore.adj2, list(F3034 = c(0,0,1,0,0,0,0,0)))
## contrast estimate SE df t.ratio p.value
## F3034 2.32 0.132 230 17.581 <.0001
#Mean for Everyone Else
contrast( pscore.adj2, list(OTHERS = c(1/7, 1/7, 0, 1/7, 1/7, 1/7, 1/7, 1/7)))
## contrast estimate SE df t.ratio p.value
## OTHERS 1.29 0.397 230 3.236 0.0014
#Contast Females 30-34 relative to all other respondents
contrast( pscore.adj2, list("Females 30-34 rel to Others" = c(-1/7, -1/7, 1, -1/7, -1/7, -1/7, -1/7, -1/7)))
## contrast estimate SE df t.ratio p.value
## Females 30-34 rel to Others 1.03 0.411 230 2.507 0.0129
# EQUIP_SCORE predicting PAIN_SCORE when controlled for BIRTHSEX & TRAINING_LEVEL & AGEBAND
# Should Equipment Score be the "outcome of interest"? (In other words, EQUIP_SCORE observed after controlling for Sex and Training Level ... or Age?)
summary(lm(PAIN_SCORE ~ EQUIP_SCORE + BIRTHSEX + TRAINING_LEVEL , data = SCORES))
##
## Call:
## lm(formula = PAIN_SCORE ~ EQUIP_SCORE + BIRTHSEX + TRAINING_LEVEL,
## data = SCORES)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6748 -0.8881 -0.2576 0.5769 3.9911
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.45994 0.47908 7.222 7.51e-12 ***
## EQUIP_SCORE -0.17932 0.06655 -2.695 0.00757 **
## BIRTHSEXM -0.42806 0.17931 -2.387 0.01778 *
## TRAINING_LEVELFirst Year -0.69206 0.38976 -1.776 0.07713 .
## TRAINING_LEVELSecond Year -0.24721 0.38969 -0.634 0.52647
## TRAINING_LEVELThird Year -0.48504 0.39572 -1.226 0.22157
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.338 on 229 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.08122, Adjusted R-squared: 0.06116
## F-statistic: 4.049 on 5 and 229 DF, p-value: 0.001534
anova(lm(PAIN_SCORE ~ EQUIP_SCORE + BIRTHSEX + TRAINING_LEVEL , data = SCORES))
## Analysis of Variance Table
##
## Response: PAIN_SCORE
## Df Sum Sq Mean Sq F value Pr(>F)
## EQUIP_SCORE 1 15.20 15.2030 8.4964 0.003911 **
## BIRTHSEX 1 10.39 10.3895 5.8063 0.016759 *
## TRAINING_LEVEL 3 10.63 3.5438 1.9805 0.117671
## Residuals 229 409.76 1.7893
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# CREATE RESPECT INDEX
RESPECT <-
SURVEY %>%
mutate( BIRTHSEX2 = case_when( BIRTHSEX == "M" ~ 0,
TRUE ~ 1 ),
RESPECT_NURSES = case_when (COMFORTABLE_ASKING_NURSES == 'Y' ~ 1,
TRUE ~ 0 ),
RESPECT_TECHS = case_when (COMFORTABLE_ASKING_TECHS == "Y" ~ 1,
TRUE ~ 0),
RESPECT_NFREQ = case_when (NURSES_ASKING == "More than Twice" ~ 0,
NURSES_ASKING == "Twice" ~ 1,
NURSES_ASKING == "Once" ~ 2,
TRUE ~ 2),
RESPECT_ESTAFF = case_when (RECOGNIZED_RESPECTED_ES_STAFF == "Y" ~ 1,
TRUE ~ 0),
RESPECT_ANES = case_when (RECOGNIZED_RESPECTED_ANESTHETISTS == "Y" ~ 1,
TRUE ~ 0),
RESPECT_GIATT = case_when (RECOGNIZED_RESPECTED_GASTRO_ATTENDING == "Y" ~ 1,
TRUE ~ 0),
RESPECT_FNAME = case_when (FIRST_NAME_NO_PERMISSION == "Y" ~ 0,
TRUE ~ 1)) %>%
rowwise() %>%
mutate(RESPECT_SCORE = sum( RESPECT_NURSES + RESPECT_TECHS + RESPECT_NFREQ + RESPECT_ESTAFF + RESPECT_ANES +
RESPECT_GIATT + RESPECT_FNAME)) %>%
select( BIRTHSEX, BIRTHSEX2, AGE2, RACE, RACE2, TRAINING_LEVEL, EVER_INJURED, starts_with("RESPECT_") )
RESPECT %>%
group_by(BIRTHSEX) %>%
summarize( RSPECTMEAN = mean(RESPECT_SCORE),
RSPECTSD = sd(RESPECT_SCORE))
## # A tibble: 2 × 3
## BIRTHSEX RSPECTMEAN RSPECTSD
## <fct> <dbl> <dbl>
## 1 F 6.12 1.53
## 2 M 6.47 1.39
shapiro.test(RESPECT$RESPECT_SCORE)
##
## Shapiro-Wilk normality test
##
## data: RESPECT$RESPECT_SCORE
## W = 0.87466, p-value = 5.03e-13
eov.ttest(RESPECT, RESPECT_SCORE, BIRTHSEX)
## [1] "F Test p.value = 0.3159401 EOV = TRUE (Pooled)"
## [1] "RESPECT : RESPECT_SCORE ~ BIRTHSEX"
##
## Two Sample t-test
##
## data: RESPECT : RESPECT_SCORE ~ BIRTHSEX
## t = -1.8751, df = 234, p-value = 0.06203
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -0.73107527 0.01807434
## sample estimates:
## mean in group F mean in group M
## 6.115044 6.471545
eov.ttest(RESPECT, RESPECT_SCORE, RACE2)
## [1] "F Test p.value = 0.5969408 EOV = TRUE (Pooled)"
## [1] "RESPECT : RESPECT_SCORE ~ RACE2"
##
## Two Sample t-test
##
## data: RESPECT : RESPECT_SCORE ~ RACE2
## t = 1.5883, df = 234, p-value = 0.1136
## alternative hypothesis: true difference in means between group WHITE and group NON-WHITE is not equal to 0
## 95 percent confidence interval:
## -0.07320387 0.68217823
## sample estimates:
## mean in group WHITE mean in group NON-WHITE
## 6.471154 6.166667
ggbetweenstats( data= RESPECT,
x = BIRTHSEX,
y = RESPECT_SCORE,
type="parametric",
p.adjust.method = "none",
title = "Mean RESPECT Scores by Birth Sex")
ggbetweenstats( data= RESPECT,
x = RACE2,
y = RESPECT_SCORE,
type="parametric",
p.adjust.method = "none",
title = "Mean RESPECT Scores by Race (Broad)")